frm_drwchild.pas

delphi语言开发的矢量图形处理对象

    Brush.Color :=clWhite;
    Brush.Style :=bsSolid;
    Pen.Color :=clGrayText;
    FillRect(rlRect);
    MoveTo(rlRect.Right -2,1);
    LineTo(rlRect.Right -2,rlRect.Bottom-2);
    if scrollBox1.VertScrollBar.Position=0 then
       tmpval:=0
    else
       tmpVal:=incSize-((scrollBox1.VertScrollBar.Position/incSize)-(scrollBox1.VertScrollBar.Position Div incSize))*incSize;
    posY:=round(tmpVal);
    if scrollBox1.VertScrollBar.Position=0 then
       i:=0
    else
       i:=trunc(scrollBox1.VertScrollBar.Position/incSize)+1;
    while posY<rlRect.Bottom do
    begin
       MoveTo(6,posY);
       LineTo(rlRect.Right -2,posY);
       TextOut(2,posY-TextHeight(intTostr(i))-2,intTostr(i));
       posY:=posY+incSize;
       inc(i);
    end;
    if scrollBox1.VertScrollBar.Position=0 then
       tmpVal:=0
    else
       tmpVal:=divSize-((scrollBox1.VertScrollBar.Position/divSize)-(scrollBox1.VertScrollBar.Position Div divSize))*divSize;
    posY:=round(tmpVal);
    while posY<rlRect.Bottom do
    begin
       MoveTo(rlRect.Right-5,posY);
       LineTo(rlRect.Right-2,posY);
       posY:=posY+divSize;
    end;
  end;
end;

procedure TfrmDrw.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=46 then
  Del_SelectObjects;
  MoveObject(Sender,key,shift);
end;

procedure TfrmDrw.GetBmp(bmp: TBitmap);
begin
  bmp.Width :=drwCanvasWidth;
  bmp.Height :=drwCanvasHeight;

  drawBack(bmp.Canvas);
  drawobjects(bmp.Canvas);
end;

procedure TfrmDrw.SaveToJpeg(sfileName: string);
var
  bmp:TBitmap;
  tmpjpeg:TJpegImage;
begin
  bmp:=TBitmap.Create;
  bmp.Width :=drwCanvasWidth;
  bmp.Height :=drwCanvasHeight;

  tmpJpeg:=TJpegImage.Create;
  try
    drawBack(bmp.Canvas);
    drawObjects(bmp.Canvas);
    tmpJpeg.Assign(bmp);
    tmpJpeg.SaveToFile(sFileName);
  finally
    bmp.Free;
    tmpJpeg.Free;
  end;
end;

procedure TfrmDrw.MoveObject(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (curDrawRef =nil) or (tsSelection.Count >1 ) then exit;
  if ssCtrl in shift then
  begin
    case key of
      VK_UP:TDrawObject(curDrawRef).addXY(0,-1,-1);
      VK_DOWN:TDrawObject(curDrawRef).addXY(0,1,-1);
      VK_LEFT:TDrawObject(curDrawRef).addXY(-1,0,-1);
      VK_RIGHT:TDrawObject(curDrawRef).addXY(1,0,-1);
    end;
    draw_RamBitmap;
  end;
end;

procedure TfrmDrw.drwPaintDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:=Source is TlistView;
end;

procedure TfrmDrw.drwPaintDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  f:TDrawGroup;
  objCaption:string;
  t,t1:TPoint;
begin
  if Source is TListView then
  begin
    with frmLib do
    begin
      objCaption:=mListView.Selected.Caption;
      mLibManager.getShapeByName(objCaption,f);
      t:=f.getMinPoint;
      t1:=f.getMaxPoint;
      f.addXY(-t.X,-t.Y,-1);//将组的矩形坐标设置成相对坐标
      f.addXY(round(x/curZoomScale),round(y/curZoomScale),-1);//将组的矩形坐标设置成实际的绝对坐标
      f.setOrg;//记录下组的矩形坐标的初始值
      f.ZoomScale :=curZoomScale;
     // f.PenColor :=curForeColor;
     // f.BrushColor :=curFillColor;
     // f.ResetPenColor;
      f.Name :='';
      tsDrwObjects.Add(f);
      draw_RamBitmap;
    end;
  end;
end;

procedure TfrmDrw.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
var
  oldMode:TPenMode;
  oldStyle:TPenStyle;
  oldBrushStyle:TBrushStyle;
begin
  with drwPaint.Canvas do
  begin
    oldMode:=Pen.Mode;
    oldStyle:=Pen.Style;
    oldBrushStyle:=Brush.Style;
    Pen.Mode := AMode;
    Pen.Style :=psDot;
    Brush.Style :=bsClear;
    drwPaint.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,BottomRight.Y);
    Pen.Mode:=oldMode;
    Pen.Style:=oldStyle;
    Brush.Style :=oldBrushStyle;
  end;
end;

procedure TfrmDrw.SelectObj(TopLeft, BottomRight: TPoint);
var
  i:integer;
  t1,t2:TPoint;
  r:TRect;
  rgn:HRGN;
begin
  t1:=Point(round(topLeft.X/curZoomScale),round(topLeft.Y/curZoomScale));
  t2:=Point(round(BottomRight.X/curZoomScale),round(BottomRight.Y/curZoomScale));
  rgn:=CreateRectRgn(t1.X,t1.Y,t2.X,t2.Y);
  tsSelection.Clear;
  for i:=0 to tsDrwObjects.Count -1 do
  begin
    r.TopLeft :=TDrawObject(tsDrwObjects.Items[i]).getMinPoint;
    r.BottomRight :=TDrawObject(tsDrwObjects.Items[i]).getMaxPoint;
    if PtInregion(rgn,r.Left,r.Top) and ptInRegion(rgn,r.Right,r.Bottom) then
    begin
       TDrawObject(tsDrwObjects.Items[i]).Selected(drwPaint.Canvas,true);
       tsSelection.Add(tsDrwObjects.Items[i]);
       curDrawRef:=tsDrwObjects.Items[i];
    end;
  end;
  DeleteObject(rgn);
  drawShape(topLeft,bottomRight,pmNotXor);
  Drawing:=false;
end;

procedure TfrmDrw.Turn_X;
begin
  if curDrawRef<>nil then
  begin
    TDrawRect(curDrawRef).Action_X;
    Draw_RamBitmap;
  end;
end;

procedure TfrmDrw.Turn_Y;
begin
  if curDrawRef<>nil then
  begin
    TDrawRect(curDrawRef).Action_Y;
    Draw_RamBitmap;
  end;
end;

procedure TfrmDrw.mnuSetDataClick(Sender: TObject);
var
  curYcData:TYcData;
  curCurveData:TCurveData;
begin
  if curDrawRef=nil then exit;
  case TDrawObject(curDrawRef).Style of
    drwRectGraph:begin
        frmSetGraph:=TfrmSetGraph.Create(Application);
        frmSetGraph.initTree(TDrawRectGraph(curDrawRef));
        try
          frmSetGraph.ShowModal;
          TDrawRectGraph(curDrawRef).Name :='RectGraph';
        finally
          draw_RamBitmap;
          frmSetGraph.Free;
        end;
       end;
    drwGrid:begin
        frmGrid_Config:=TfrmGrid_Config.Create(application);
        try
          frmGrid_Config.UpDown1.Position :=TDrawGrid(curDrawRef).RowCount;
          frmGrid_Config.UpDown2.Position :=TDrawGrid(curDrawRef).ColCount;
          if frmGrid_Config.ShowModal =mrOk then
          begin
            TDrawGrid(curDrawRef).RowCount :=frmGrid_Config.UpDown1.Position;
            TDrawGrid(curDrawRef).ColCount :=frmGrid_Config.UpDown2.Position;
            draw_RamBitmap;
          end;
        finally
          freeAndNil(frmGrid_Config);
        end;
    end;
    drwLineGraph:begin
        frmLineConfig:=TfrmLineConfig.Create(Application);
        frmLineConfig.initParam(TDrawLineGraph(curDrawRef));
        try
          frmLineConfig.ShowModal;
          TDrawLineGraph(curDrawRef).Name :='realLine';
        finally
          draw_RamBitmap;
          frmLineConfig.Free;
        end;
       end;
    drwYc:begin
       frmYc_Config:=TfrmYc_Config.Create(application);
       try
        curYcData:=TDrawYcText(curDrawRef).Yc_Data;
        frmYc_Config.initParam(curYcData);
        if frmYc_Config.ShowModal=mrOk then
        begin
          TDrawYcText(curDrawRef).Yc_Data :=frmYc_Config.cur_Param;
          TDrawYcText(curDrawRef).Name :='Yc';
        end;
       finally
        freeAndNil(frmYc_Config);
        draw_RamBitmap;
       end;
    end;
    drwCurve:begin
       frmCurve_Config:=TfrmCurve_Config.Create(application);
       curCurveData:=TDrawCurveText(CurDrawRef).Curve_Data;
       try
         frmCurve_Config.initParam(curCurveData); 
         if frmCurve_Config.ShowModal =mrOk then
         begin
          TDrawCurveText(curDrawRef).Curve_Data :=frmCurve_Config.cur_Param;
          TDrawCurveText(curDrawRef).Name :='curveYc';
         end;
       finally
          freeAndNil(frmCurve_Config);
          draw_RamBitmap;
       end;
    end;
    else
       frmYx_Config:=TfrmYx_Config.Create(application);
       try
         frmYx_Config.edtNum.Text :=TDrawObject(curDrawRef).Info;
         if frmYx_Config.ShowModal =mrOk then
         begin
           if frmYx_Config.edtNum.Text ='' then
           begin
              TDrawObject(curDrawRef).Name :='';
              TDrawObject(curDrawRef).Info :='';
           end
           else begin
              TDrawObject(curDrawRef).Name :=frmYx_Config.cboYx.Text;
              TDrawObject(curDrawRef).Info :=frmYx_Config.edtNum.Text;
           end;
         end;
       finally
         freeAndNil(frmYx_Config);
         draw_RamBitmap;
       end;
  end;
end;

procedure TfrmDrw.PrintObj;
var
 tm  : TMetafile;
 tmc : TMetaFileCanvas;
begin
   tm        := Tmetafile.create;
   tm.width  :=drwCanvasWidth;
   tm.height :=drwCanvasHeight;
   tmc       := TMetaFileCanvas.Create(tm,0);

   drawBack(tmc);
   drawObjects(tmc);
   tmc.Free;

   Print_previewer.ClearPrintBuff;
   Print_previewer.add_metafile(1,tm,curBackcolor,1,1);
   Print_previewer.Preview;
end;

procedure TfrmDrw.DrawTitled(drwCanvas: TCanvas;CR:TRect;RamBitmap:TBitmap);
var
  Row, Col: Integer;
  IR: TRect;
  NumRows, NumCols: Integer;
begin
  IR:=Rect(0,0,ramBitmap.Width,ramBitmap.Height);
  NumRows := CR.Bottom div IR.Bottom;
  NumCols := CR.Right div IR.Right;
  for Row := 0 to NumRows+1 do
    for Col := 0 to NumCols+1  do
    BitBlt(drwCanvas.Handle, Col * ramBitmap.Width, Row * ramBitmap.Height,
           ramBitmap.Width, ramBitmap.Height, ramBitmap.Canvas.Handle,
           0, 0, SRCCOPY);
end;

procedure TfrmDrw.DrawStretched(drwCanvas: TCanvas; CR: TRect;
  RamBitmap: TBitmap);
begin
  StretchBlt(drwCanvas.Handle, 0, 0, CR.Right, CR.Bottom,
             ramBitmap.Canvas.Handle, 0, 0,ramBitmap.Width, ramBitmap.Height, SRCCOPY);
end;

procedure TfrmDrw.DrawCentered(drwCanvas: TCanvas; CR: TRect;
  RamBitmap: TBitmap);
begin
  BitBlt(drwCanvas.Handle, ((CR.Right - CR.Left) - RamBitmap.Width) div 2,
        ((CR.Bottom - CR.Top) - RamBitmap.Height) div 2,RamBitmap.Width,
        RamBitmap.Height,RamBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TfrmDrw.setBackBitmap(sFile: string; iMode: integer);
var
  fileExt:string;
  tmpJpg:TJpegImage;
  tmpIcon:TIcon;
begin
  if sFile='none' then
  begin
    bLoadMap:=false;
    exit;
  end;
  if sFile='' then
  begin
    if not bLoadMap then exit;
    iArrangeMode:=iMode;
    exit;
  end;
  if not FileExists(sFile) then exit;
  bLoadMap:=true;
  iArrangeMode:=iMode;
  fileExt:=lowerCase(ExtractFileExt(sFile));
  if fileExt='.bmp' then
     backBitmap.LoadFromFile(sFile)
  else if (fileExt='.jpg') or (fileExt='.jpeg') then
  begin
     tmpJpg:=TJpegImage.Create;
     try
      tmpJpg.LoadFromFile(sFile);
      backBitmap.Width :=tmpJpg.Width;
      backBitmap.Height :=tmpJpg.Height;
      backBitmap.Canvas.StretchDraw(Rect(0,0,backBitmap.Width,backBitmap.Height),tmpJpg);
     finally
      tmpJpg.Free;
     end;
  end;
  if fileExt='.ico' then
  begin
     tmpIcon:=TIcon.Create;
     try
      tmpIcon.LoadFromFile(sFile);
      backBitmap.Width :=tmpIcon.Width;
      backBitmap.Height :=tmpIcon.Height;
      backBitmap.Canvas.StretchDraw(Rect(0,0,backBitmap.Width,backBitmap.Height),tmpIcon);
     finally
      tmpIcon.free;
     end;
  end;
end;

procedure TfrmDrw.FormDestroy(Sender: TObject);
begin
  backBitmap.Free;
  Print_previewer.Free;  
end;

procedure TfrmDrw.reLoadBackSet;
begin
  if bLoadMap then
  begin
    frmSetPic.sFilePic:='';
    frmSetPic.Edit1.Text :='(bmpImage)';
    frmSetPic.Image1.Picture.Bitmap.Assign(backBitmap);
    frmSetPic.CheckBox1.Checked :=true;
  end;
end;

end.