frm_drwchild.pas

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

    curDrawRef:=nil;
    draw_RamBitmap;
  end;
  {弹出操作菜单}
  if drwTool=drwSelect then
  PopupMnu(round(x*curZoomScale),round(y*curZoomScale));
end;

procedure TfrmDrw.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;

procedure TfrmDrw.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 TfrmDrw.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  action:=caFree;
end;

procedure TfrmDrw.Drag_SelectObjects(x, y: integer);
var
  i:integer;
  f:TDrawGroup;
begin
  f:=TDrawGroup.create;
  for i:=tsDrwobjects.Count -1 Downto 0 do
  begin
    if TDrawObject(tsDrwobjects.Items[i]).mSelected then
    f.addObject(tsDrwObjects.Items[i]);
  end;
  f.getRect;//设置组的矩形坐标范围
  f.ZoomScale :=curZoomScale;
  f.MoveAt(drwPaint.Canvas,-1,x,y);
  f.setAllDeadXY;
  f.Free;
end;

procedure TfrmDrw.SetCursors(x, y: integer);
var
 iPos:integer;
begin
 if curDrawRef=nil then
 begin
   screen.Cursor :=crDefault;
   exit;
 end;
 if tsSelection.Count >1 then exit;
 iPos:=TDrawObject(curDrawRef).SelectAt(x,y);
 case TDrawObject(curDrawRef).Style of
   drwLine,drwPLine,drwPolygon,drwFreeLine:
   begin
     if iPos>0 then
        screen.Cursor :=crCross
     else if iPos=0 then
        screen.Cursor :=crDefault
     else
        screen.Cursor :=crSizeAll;
   end;
   drwRect,drwGrid,drwRectGraph,drwLineGraph,drwText,drwYc,drwCurve,drwEllispe,drwImage,drwCircle,drwGroup,drwSanJiao:
   begin
     if (iPos=1) or (iPos=4) then
        screen.Cursor :=crSizeNWSE
     else if (iPos=2) or (iPos=3) then
        screen.Cursor :=crSizeNESW
     else if iPos=0 then
        screen.Cursor :=crDefault
     else
        screen.Cursor :=crSizeAll;
   end;
 end;
end;

procedure TfrmDrw.PopupMnu(x, y: integer);
var
 t:TPoint;
begin
 t:=Point(x,y);
 t:=drwPaint.ClientToScreen(t);
 drwPopMenu.Popup(t.X,t.y);
end;

procedure TfrmDrw.mnuLineSetClick(Sender: TObject);
var
  f:TDrawObject;
begin
  frmSetLine:=TFrmSetLine.create(Application);
  try
    f:=TDrawObject(curDrawRef);
    frmSetLine.cmoLineColor.Selected :=f.PenColor;
    case f.PenWidth of
      1:frmSetLine.cmoLineWidth.ItemIndex :=0;
      2:frmSetLine.cmoLineWidth.ItemIndex :=1;
      4:frmSetLine.cmoLineWidth.ItemIndex :=2;
      6:frmSetLine.cmoLineWidth.ItemIndex :=3;
      8:frmSetLine.cmoLineWidth.ItemIndex :=4;
    else
      frmSetLine.cmoLineWidth.ItemIndex :=5;
    end;
    frmSetLine.lblWidth.Caption :=intTostr(f.PenWidth)+'P';
    if f.Style <>drwGroup then
      begin
      frmSetLine.cmoLineType.ItemIndex :=integer(f.PenStyle);
      frmSetLine.cmoLineType.Enabled :=true;
      end
    else
      frmSetLine.cmoLineType.Enabled :=false;
    if f.Style =drwLine then
    begin
       frmSetLine.cmoLineArrow.ItemIndex :=integer(TDrawLine(f).ArrowStyle );
       frmSetLine.cmoLineArrow.Enabled :=true;
    end
    else
    begin
       frmSetLine.cmoLineArrow.Enabled :=false;
    end;
    if frmSetLine.ShowModal=mrOk then
    begin
      f.PenColor :=frmSetLine.cmoLineColor.Selected;
      f.PenWidth :=strToint(copy(frmSetLine.lblWidth.Caption,
                   1,length(frmSetLine.lblWidth.Caption)-1));
      curPenWidth:=strToint(copy(frmSetLine.lblWidth.Caption,
                   1,length(frmSetLine.lblWidth.Caption)-1));
      if f.Style <>drwGroup then
      f.PenStyle :=TPenStyle(frmSetLine.cmoLineType.ItemIndex);
      if f.Style =drwLine then
      TDrawLine(f).ArrowStyle :=TArrowStyle(frmSetLine.cmoLineArrow.ItemIndex);
      if f.Style =drwGroup then
      begin
        TDrawGroup(f).ResetPenColor;
        TDrawGroup(f).ResetPenWidth;
      end;
      draw_Rambitmap;
    end;
  finally
    frmSetLine.Free;
  end;
end;

procedure TfrmDrw.mnuFill_ColorClick(Sender: TObject);
var
  f:TDrawObject;
begin
  f:=TDrawObject(curDrawRef);
  frm_FillSet:=TFrm_FillSet.Create(Application);
  case f.Style of
    drwRect:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawRect(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawRect(curDrawRef).BrushStyle);
    end;
    drwEllispe:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawEllipse(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawEllipse(curDrawRef).BrushStyle);
    end;
    drwCircle:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawCircle(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawCircle(curDrawRef).BrushStyle);
    end;
    drwPolygon:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawPolygon(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawPolygon(curDrawRef).BrushStyle);
    end;
    drwFreeLine:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawFreeLine(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawFreeLine(curDrawRef).BrushStyle);
    end;
    drwGrid:begin
     frm_fillSet.cmoFillColor.Selected :=TDrawGrid(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawGrid(curDrawRef).BrushStyle);
    end;
    drwGroup:
    begin
      frm_fillSet.cmoFillColor.ItemIndex:= -1;
      frm_fillset.cmoFillMode.ItemIndex:=-1;
    end;
  end;
  frm_FillSet.cboMode.ItemIndex :=ord(f.GradientStyle);
  frm_fillSet.cboStart.Selected :=f.BeginColor;
  frm_fillSet.cboEnd.Selected :=f.EndColor;
  if f.Style in [drwCircle,drwEllispe,drwRect,drwPolygon,drwGrid,drwFreeLine] then
  begin
     frm_fillSet.RadioButton1.Checked:=f.Gradient;
     frm_fillSet.RadioButton2.Checked :=not f.Gradient;
     frm_fillSet.GroupBox3.Enabled :=true;
  end
  else begin
     frm_fillSet.RadioButton1.Checked :=false;
     frm_fillSet.RadioButton2.Enabled :=true;
     frm_fillSet.GroupBox3.Enabled :=false;
  end;
  try
    if frm_fillSet.ShowModal=mrOk then
    begin
      case f.Style of
        drwRect:
        begin
          TdrawRect(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawRect(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwCircle:
        begin
          TdrawCircle(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawCircle(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwEllispe:
        begin
          TdrawEllipse(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawEllipse(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwGrid:begin
          TdrawGrid(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawGrid(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwPolygon:
        begin
          TdrawPolygon(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawPolygon(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwFreeLine:
        begin
          TdrawFreeLine(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawFreeLine(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwGroup:TDrawGroup(curDrawRef).BrushColor :=frm_fillset.cmoFillColor.Selected;
      end;
      if f.Style in [drwFreeLine,drwCircle,drwRect,drwEllispe,drwPolygon,drwGrid] then
      begin
         f.Gradient :=frm_fillset.RadioButton1.Checked;
         f.BeginColor :=frm_fillset.cboStart.Selected;
         f.EndColor :=frm_fillset.cboEnd.Selected;
         f.GradientStyle :=TGradientStyle(frm_fillset.cboMode.ItemIndex);
      end;
      draw_RamBitmap;
    end;
  finally
    frm_fillSet.Free;
  end;
end;

function TfrmDrw.getIndex(value: TBrushStyle): integer;
begin
  case value of
    bsBDiagonal:result:=5;
    bsClear:result:=1;
    bsCross:result:=6;
    bsDiagCross:result:=7;
    bsFDiagonal:result:=4;
    bsHorizontal:result:=2;
    bsSolid:result:=0;
    bsVertical:result:=3;
  end;
end;

{BreakGroup过程把一个组合的图形进行分解}
procedure TfrmDrw.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 TfrmDrw.CreateGroup;
var
  i:integer;
  f:TDrawGroup;
begin
  f:=TDrawGroup.create;
  for i:=tsDrwobjects.Count -1 Downto 0 do
  begin
    if TDrawObject(tsDrwobjects.Items[i]).mSelected then
    begin
      //drwlineGraph\drwRectGraph不能组合
      if TDrawObject(tsDrwobjects.Items[i]).Style in [drwLineGraph,drwRectGraph] then
      continue;
      f.addObject(tsDrwObjects.Items[i]);
      TDrawObject(tsDrwObjects.Items[i]).Selected(drwPaint.Canvas,false);
      tsDrwObjects.Delete(i);
    end;
  end;
  f.getRect;//设置组的矩形坐标范围
  f.ZoomScale :=curZoomScale;
  f.Selected(drwPaint.Canvas,true);
  f.Style :=drwGroup;
  tsDrwObjects.Add(f);
  curDrawRef:=f;
  tsSelection.Clear;
  tsSelection.Add(f);
end;

procedure TfrmDrw.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;
  draw_RamBitmap;
end;

procedure TfrmDrw.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 TfrmDrw.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 TfrmDrw.readObjectStream(f: TStream);
var
  drwMode:TDrwStyle;
begin
    f.Read(drwMode,sizeOf(TDrwStyle));
    case drwMode of
      drwLine:addObjects(TDrawLine,drwMode,f);
      drwRect:addObjects(TDrawRect,drwMode,f);
      drwCircle:addObjects(TDrawCircle,drwMode,f);
      drwEllispe:addObjects(TDrawEllipse,drwMode,f);
      drwPLine:addObjects(TDrawPLine,drwMode,f);
      drwPolygon:addObjects(TDrawPolygon,drwMode,f);
      drwText:addObjects(TDrawText,drwMode,f);
      drwImage:addObjects(TDrawImage,drwImage,f);
      drwGroup:addObjects(TDrawGroup,drwGroup,f);
      drwArc:addObjects(TDrawArc,drwArc,f);
      drwFreeLine:addObjects(TDrawFreeLine,drwFreeLine,f);
      drwSanJiao:addObjects(TDrawSanJiao,drwSanJiao,f);
      drwRectGraph:addObjects(TDrawRectGraph,drwRectGraph,f);
      drwLineGraph:addObjects(TDrawLineGraph,drwLineGraph,f);
      drwYc:addObjects(TDrawYcText,drwYc,f);
      drwCurve:addObjects(TDrawCurveText,drwCurve,f);
      drwGrid:addObjects(TDrawGrid,drwGrid,f);
    end;
end;