frm_main.~pas

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

end;
procedure TfrmMain.drwPaintMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //鼠标左键的处理过程
  if Button=mbLeft then
  begin
    MouseLeftDown(Sender,Button,shift, round(X/curZoomScale), round(Y/curZoomScale));
    if curDrawRef<>nil then
    checkBox1.Checked :=TDrawObject(curDrawRef).isVisible;
  end;

  //鼠标右键按下时的处理过程
  if Button=mbRight then
  MouseRightDown(Sender,Button,Shift, round(X/curZoomScale), round(Y/curZoomScale));
end;

procedure TfrmMain.drwPaintMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if (curDrawRef<>nil) and bDrawing then
  begin
    if (TDrawObject(curDrawRef).Style =drwFreeLine) and (drwTool=drwFreeLine) then
    begin
       TDrawFreeLine(curDrawRef).AddPoint(round(x/curZoomScale),round(y/curZoomScale));
       TDrawFreeLine(curDrawRef).Draw(drwPaint.Canvas);
    end
    else
       TDrawObject(curDrawRef).MoveAt(drwPaint.Canvas,iMoveMode,round(x/curZoomScale),round(y/curZoomScale));
    isMove:=true;
    isModify:=true;
  end;
  if not bDrawing then
  SetCursors(round(x/curZoomScale), round(y/curZoomScale));//设置光标显示
  if Drawing then
  begin
    DrawShape(Origin, MovePt, pmNotXor);
    MovePt := Point(X, Y);
    DrawShape(Origin, MovePt, pmNotXor);
  end;
end;

procedure TfrmMain.drwPaintMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if bDrawing then
   begin
      if drwTool in [drwLine,drwRect,drwCircle,drwEllispe,drwArc,drwFreeLine,drwSanJiao] then
      begin
        clipCursor(nil);//恢复鼠标范围的限制
        if TDrawObject(curDrawRef).IsValid then
        begin
          tsDrwObjects.Add(curDrawRef);
          TDrawObject(curDrawRef).Draw(drwPaint.Canvas);
        end;
        bDrawing:=false;
        curDrawRef:=nil;
        isMove:=false;
      end;
   end;
   if drwTool=drwSelect then
   begin
      if bDrawing then
      begin
        if (TDrawObject(curDrawRef).Style =drwGroup) then
        TDrawObject(curDrawRef).setOrg;//重新设置组内各图元的初始保存点
      end;
      clipCursor(nil);
      bDrawing:=false;
      Screen.Cursor :=crDefault;
      IF (curDrawRef<>nil) and isMove then
      draw_RamBitmap;//在内存中重画图形，在拷贝到当前画布
      isMove:=false;
      if Drawing then
      SelectObj(Origin, MovePt);
   end;
end;

procedure TfrmMain.BreakGroup;
var
  i:integer;
begin
  if curDrawRef=nil then exit;
  tsSelection.Clear;
  if TDrawObject(curDrawRef).Style <>drwGroup then exit;
  TDrawGroup(curDrawRef).setAllDeadXY;//还原各图元的绝对坐标
  for i:=0 to TDrawGroup(curDrawRef).CountObjGroups -1 do
  begin
    if TDrawObject(TDrawGroup(curDrawRef).objGroups[i]).Style =drwGroup then
    TDrawGroup(TDrawGroup(curDrawRef).objGroups[i]).setAllVersus;//还原组中图元的相对坐标
    tsDrwObjects.Add(TDrawGroup(curDrawRef).objGroups[i]);
    tsSelection.Add(TDrawGroup(curDrawRef).objGroups[i]);
    TDrawObject(TDrawGroup(curDrawRef).objGroups[i]).ZoomScale :=curZoomScale;
    TDrawObject(TDrawGroup(curDrawRef).objGroups[i]).Selected(drwPaint.Canvas,true);
  end;
  i:=tsDrwObjects.IndexOf(curDrawRef);
  if i<>-1 then
  tsDrwObjects.Delete(i);
  TDrawGroup(curDrawRef).Selected(drwPaint.Canvas,false);
  TDrawGroup(curDrawRef).Free;
  curDrawRef:=nil;
end;

procedure TfrmMain.CopyToClipboard;
var
  hbuf : THandle;
  bufptr : Pointer;
  mstream : TMemoryStream;
begin
  mstream := TMemoryStream.Create;
  try
    {-- 处理流的代码 --}
    writeObjectStream(mStream);//将选中的图形数据写到内存流中
    hbuf := GlobalAlloc(GMEM_MOVEABLE, mstream.size);
    try
      bufptr := GlobalLock(hbuf);
      try
        Move(mstream.Memory^, bufptr^, mstream.size);
        Clipboard.SetAsHandle(CF_MYFORMAT, hbuf);
      finally
      GlobalUnlock(hbuf);
      end;
    except
      GlobalFree(hbuf);
    raise;
    end;
  finally
    mstream.Free;
  end;
end;

function TfrmMain.CreateGroup:TDrawGroup;
var
  i:integer;
  f:TDrawGroup;
  tmp:Boolean;
begin
  f:=TDrawGroup.create;
  for i:=tsDrwobjects.Count -1 Downto 0 do
  begin
     tmp:=TdrawObject(tsDrwObjects.Items[i]).isVisible;//是否可见
     TDrawObject(tsDrwObjects.Items[i]).Visible :=tmp;
     if (TDrawObject(tsDrwObjects.Items[i]).Style =drwGroup) and (tmp=false) then
     TDrawGroup(tsDrwObjects.Items[i]).setObjVisible(false);
     f.addObject(tsDrwObjects.Items[i]);
  end;
  f.getRect;//设置组的矩形坐标范围
  f.Style :=drwGroup;
  result:=f;
end;

procedure TfrmMain.CutToClipboard;
begin
  CopyToClipboard;
  Del_SelectObjects;
end;

procedure TfrmMain.Del_SelectObjects;
var
  i:integer;
  F:TDrawObject;
begin
  for i:=tsDrwObjects.Count -1 downto 0 do
  begin
    f:=TDrawObject(tsDrwObjects.Items[i]);
    if f.mSelected then
    begin
      if f.Style =drwGroup then
      TDrawGroup(tsDrwObjects.Items[i]).deleteObjects;
      f.Free;
      tsDrwObjects.Delete(i);
    end;
  end;
  tsSelection.Clear;
  curDrawRef:=nil;
  Draw_RamBitmap;//重新遍历图元画图
end;

procedure TfrmMain.draw_RamBitmap;
var
  map:TBitmap;
begin
  map:=TBitmap.Create;
  try
    map.Width :=round(drwCanvasWidth*curZoomScale);
    map.Height :=round(drwCanvasHeight*curZoomScale);
    drawBack(map.Canvas);
    drawObjects(map.Canvas);
    drwPaint.Canvas.Draw(0,0,map);
  finally
    map.Free;
  end;
end;

function TfrmMain.getBkColor: TColor;
begin
  result:=curBackColor;
end;

procedure TfrmMain.PasteFromClipboard;
var
  hbuf : THandle;
  bufptr : Pointer;
  mstream : TMemoryStream;
  i:integer;
begin
  for i:=0 to tsSelection.Count -1 do
  TDrawObject(tsSelection.Items[i]).Selected(drwPaint.Canvas,false);
  tsSelection.Clear;
  curDrawRef:=nil;
  hbuf := Clipboard.GetAsHandle(CF_MYFORMAT);
  if hbuf <> 0 then
  begin
    bufptr := GlobalLock(hbuf);
    if bufptr <> nil then
    begin
     try
        mstream := TMemoryStream.Create;
        try
          mstream.WriteBuffer(bufptr^, GlobalSize(hbuf));
          mstream.Position := 0;
          {-- 处理流的代码 --}
          i:=mstream.Size;
          while i-mstream.Position >0 do
          ReadObjectStream(mStream);
          for i:=0 to tsSelection.Count -1 do
          begin
            TDrawObject(tsSelection.Items[i]).addXY(2,2,-1);
            TDrawObject(tsSelection.Items[i]).ZoomScale :=curZoomScale;
            TDrawObject(tsSelection.Items[i]).Draw(drwPaint.Canvas);
            TDrawObject(tsSelection.Items[i]).Selected(drwPaint.Canvas,true);
          end;
          if tsSelection.Count >0 then curDrawRef:=tsSelection.Items[0];
        finally
        mstream.Free;
        end;
      finally
        GlobalUnlock(hbuf);
      end;
    end;
  end;
end;

procedure TfrmMain.redrawText;
begin
{  j:=0;
  for i:=0 to tsSelection.Count -1 do
  begin
    if TDrawObject(tsSelection.Items[i]).Style =drwText then
    begin
       TDrawText(tsSelection.Items[i]).Font.Name :=fontcom.Items.Strings[frmMain.fontcom.ItemIndex];
       TDrawText(tsSelection.Items[i]).Font.Size :=fontspin.Value;
       TDrawText(tsSelection.Items[i]).isBold :=btnBold.Down;
       TDrawText(tsSelection.Items[i]).isItaic :=btnItalic.Down;
       TDrawText(tsSelection.Items[i]).isUnderLine :=btnLine.Down;
       j:=j+1;
    end;
  end;
  没有选择任何图形改变系统的默认格式
  if tsSelection.Count=0 then
  begin
    curTextName:=fontcom.Items.Strings[frmMain.fontcom.ItemIndex];
    curTextSize:=fontSpin.Value;
    bFontBold:=btnBold.Down;
    bFontItalic:=btnItalic.Down;
    bFontUnderLine:=btnLine.Down;
  end;
  if j>0 then
  draw_Rambitmap;}
end;

procedure TfrmMain.SendObject_Back;
var
  iPos:integer;
begin
  if curDrawRef=nil then exit;
  iPos:=tsDrwObjects.IndexOf(curDrawRef);
  if iPos<>tsDrwObjects.Count -1 then
  begin
    tsDrwObjects.Delete(iPos);
    tsDrwObjects.Add(curDrawRef);
    draw_RamBitmap;
  end;
end;

procedure TfrmMain.SendObject_Front;
var
  iPos:integer;
begin
  if curDrawRef=nil then exit;
  iPos:=tsDrwObjects.IndexOf(curDrawRef);
  if iPos<>0 then
  begin
    tsDrwObjects.Delete(iPos);
    tsDrwObjects.Insert(0,curDrawRef);
    draw_RamBitmap;
  end;
end;

procedure TfrmMain.setAlign(flag: TAlign);
var
  i,incX,incY:integer;
  lPoint,tmpPoint:TPoint;
begin
  case flag of
    taLeft:begin
       lPoint:=TDrawObject(tsSelection.Items[0]).getMinPoint;
       incY:=0;
       for i:=1 to tsSelection.Count -1 do
       begin
         tmpPoint:=TDrawObject(tsSelection.Items[i]).GetMinPoint;
         incX:=lPoint.X -tmpPoint.X;
         TDrawObject(tsSelection.Items[i]).addXY(incx,incy,-1);
       end;
    end;
    taRight:begin
       incY:=0;
       lPoint:=TDrawObject(tsSelection.Items[0]).getMaxPoint;
       for i:=1 to tsSelection.Count -1 do
       begin
         tmpPoint:=TDrawObject(tsSelection.Items[i]).getMaxPoint;
         incX:=lPoint.x-tmpPoint.X;
         TDrawObject(tsSelection.Items[i]).addXY(incx,incy,-1);
       end;
    end;
    taTop:begin
       incX:=0;
       lPoint:=TDrawObject(tsSelection.Items[0]).getMinPoint;
       for i:=1 to tsSelection.Count -1 do
       begin
         tmpPoint:=TDrawObject(tsSelection.Items[i]).GetMinPoint;
         incY:=lPoint.Y -tmpPoint.Y;
         TDrawObject(tsSelection.Items[i]).addXY(incx,incy,-1);
       end;
    end;
    taBottom:begin
       incX:=0;
       lPoint:=TDrawObject(tsSelection.Items[0]).getMaxPoint;
       for i:=1 to tsSelection.Count -1 do
       begin
         tmpPoint:=TDrawObject(tsSelection.Items[i]).getMaxPoint;
         incY:=lPoint.Y-tmpPoint.Y;
         TDrawObject(tsSelection.Items[i]).addXY(incx,incy,-1);
       end;
    end;
  end;
  draw_Rambitmap;
end;

procedure TfrmMain.setBkColor(value: TColor);
begin
  if value=curBackColor then exit;
  curBackColor:=value;
  draw_Rambitmap;
end;

procedure TfrmMain.ZoomInOut(value: single);
var
  i:integer;
begin
  if value=curZoomScale then exit;
  drwPaint.Width :=round(drwCanvasWidth*value);
  drwPaint.Height :=round(drwCanvasHeight*value);
  curZoomScale:=value;
  for i:=0 to tsDrwObjects.Count-1 do
  TDrawObject(tsDrwObjects.Items[i]).ZoomScale:=value;
  centerDrwPaint;
  draw_RamBitmap;
end;

procedure TfrmMain.addObjects(drwRef: TDrwTool; tmpMode: TDrwStyle;
  f: TStream);
var
  drw_ref:TDrawObject;
begin
  drw_Ref:=drwRef.create;
  drw_ref.Load(f);
  tsDrwObjects.Add(drw_ref);
  drw_Ref.Style :=tmpMode;
  if tmpMode=drwGroup then
  drw_Ref.setOrg;//重新设置组内各图元的初始保存点
  tsSelection.Add(drw_Ref);
end;

procedure TfrmMain.CancelSelect(var msg: TMessage);
var
  i:integer;
begin
  if tsSelection.Count =0 then exit;
  for i:=0 to tsSelection.Count -1 do
  TDrawObject(tsSelection.Items[i]).Selected(drwPaint.Canvas,false);
  tsSelection.Clear;
  curDrawRef:=nil;
end;

procedure TfrmMain.drawBack(tmpCanvas: TCanvas);
var
  i:integer;
  irow,icol:integer;
  oldBrushColor,oldPenColor:TColor;
  oldBrushStyle:TBrushStyle;
  oldPenStyle:TPenStyle;
begin
  iCol:=drwCanvasWidth div 20;
  iRow:=drwCanvasHeight div 20;
  oldBrushColor:=tmpCanvas.Brush.Color;
  oldBrushStyle:=tmpCanvas.Brush.Style;
  oldPenColor:=tmpCanvas.Pen.Color;
  oldPenStyle:=tmpCanvas.Pen.Style;
  tmpCanvas.Brush.Color :=curBackColor;
  tmpCanvas.Brush.Style :=bsSolid;
  tmpCanvas.FillRect(rect(0,0,round(drwCanvasWidth*curZoomScale),round(drwCanvasHeight*curZoomScale)));
  tmpCanvas.Brush.Style :=bsClear;
  tmpCanvas.Pen.Style :=psDot;
  tmpCanvas.Pen.Color :=clMedGray;
  if bGridVisible then
  begin
    for i:=1 to irow-1 do
    begin
      tmpCanvas.MoveTo(0,round(i*20*curZoomScale));
      tmpCanvas.LineTo(round(drwCanvasWidth*curZoomScale),round(i*20*curZoomScale));
    end;
    for i:=1 to iCol-1 do
     begin
      tmpCanvas.MoveTo(round(i*20*curZoomScale),0);
      tmpCanvas.LineTo(round(i*20*curZoomScale),round(drwCanvasHeight*curZoomScale));
    end;
  end;
  tmpCanvas.Pen.Style :=oldPenStyle;
  tmpCanvas.Pen.Color :=oldPenColor;
  tmpCanvas.Brush.Style :=oldBrushStyle;
  tmpCanvas.Brush.Color :=oldBrushColor;
end;

procedure TfrmMain.drawObjects(drwCanvas: TCanvas);
var
  i:integer;
  drw_Ref:Pointer;
begin
  if tsDrwObjects.Count =0 then
  exit;
  for i:=0 to tsDrwObjects.Count -1 do
  begin
     drw_Ref:=tsDrwObjects.Items[i];
     TDrawObject(drw_ref).Draw(drwCanvas);
  end;
end;

procedure TfrmMain.drawSelect(shift: TShiftState; x, y: Integer);
{当处于选择状态，判断是否选择了图形}
var
  i,j,tmp_newPos,oldPos:integer;
  tmp_ref:Pointer;
begin
  if not(ssShift in shift) then
  begin
    tsSelection.Clear;
    for i:=tsDrwobjects.Count -1 downto 0 do
    begin
      curDrawRef:=tsDrwobjects.Items[i];
      iMoveMode:=TDrawObject(curDrawRef).SelectAt(x,y);
      if iMoveMode<>0 then
      begin
        TDrawObject(curDrawRef).Selected(drwPaint.Canvas,true);
        if TDrawObject(curDrawRef).Style =drwPolygon then
        TDrawPolygon(curDrawRef).isEdit :=true;
        tsSelection.Add(curDrawRef);
        if iMoveMode=-1 then
        screen.Cursor :=crSizeAll;
        bDrawing:=true;
        break;
      end
      else
      TDrawObject(curDrawRef).Selected(drwPaint.Canvas,false);
      curDrawRef:=nil;