frm_main.pas

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

      bDrawing:=false;
    end;
    for j:=i-1 downto 0 do
    TDrawObject(tsDrwObjects.Items[j]).Selected(drwPaint.Canvas,false);
  end
  else
  begin
    tmp_newPos:=0;
    oldPos:=iMoveMode;
    for i:=tsDrwObjects.Count -1 downto 0 do
    begin
      curDrawRef:=tsDrwObjects.Items[i];
      iMoveMode:=TDrawObject(curDrawRef).SelectAt(x,y);
      if iMoveMode<>0 then
      begin
        tsSelection.Add(curDrawRef);
        TDrawObject(curDrawRef).Selected(drwPaint.Canvas,true);
        tmp_newPos:=iMoveMode;
        tmp_Ref:=curDrawRef;
      end;
    end;
    if tsSelection.Count >0 then
    bDrawing:=true;
    if tmp_newPos<>0 then
    begin
      iMoveMode:=tmp_newPos;
      curDrawRef:=tmp_Ref;
    end
    else
    iMoveMode:=oldPos;
  end;
  setTextStatus;//设置文字的修饰格式的状态
 // fontspin.Tag :=0;
end;

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

function TfrmMain.getFontStyle: TFontStyles;
begin
  result:=[];
  if bFontBold then
  result:=[fsBold];
  if bFontItalic then
  result:=result+[fsItalic];
  if bFontUnderLine then
  result:=result+[fsUnderLine];
end;

function TfrmMain.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;

procedure TfrmMain.MouseLeftDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  rectClient:TRect;
begin
  rectClient:=ScrollBox1.ClientRect;
  rectClient.TopLeft :=ScrollBox1.ClientToScreen(rectClient.TopLeft);
  rectClient.BottomRight :=ScrollBox1.ClientToScreen(rectClient.BottomRight);
  clipCursor(@rectClient);//设置鼠标的限制范围
  case drwTool of
    drwSelect:begin
           if curDrawRef<>nil then
           {判断是否选择了当前的图形，如果是直接使用，否则进行图形的重新选择}
           if (iMoveMode=TDrawObject(curDrawRef).SelectAt(x,y)) and (iMoveMode<>0) then
           begin
             bDrawing:=true;
             if iMoveMode=-1 then
             screen.Cursor :=crSizeAll;
             exit;
           end;
           drawSelect(shift,x,y);
           {鼠标选择图形块}
           if curDrawRef=nil then
           begin
            Drawing := True;
            Origin := Point(round(X*curZoomScale),round(Y*curZoomScale));
            MovePt := Origin;
           end;
           end;
    drwLine:begin
            bDrawing:=true;
            curDrawRef:=TDrawLine.create;
            iMoveMode:=TDrawline(curDrawRef).NewPoint(x,y);
            TDrawObject(curDrawRef).Style :=drwLine;
            TDrawObject(curDrawRef).PenColor :=curForeColor;
            end;
    drwArc:begin
            bDrawing:=true;
            curDrawRef:=TDrawArc.create;
            iMoveMode:=TDrawArc(curDrawRef).NewPoint(x,y);
            TDrawObject(curDrawRef).Style :=drwArc;
            TDrawObject(curDrawRef).PenColor :=curForeColor;
            end;
    drwRect:begin
            bDrawing:=true;
            curDrawRef:=TDrawRect.create;
            iMoveMode:=TDrawRect(curDrawRef).NewPoint(x,y);
            TDrawObject(curDrawRef).Style :=drwRect;
            TDrawObject(curDrawRef).PenColor :=curForeColor;
            if isRound then
            TDrawRect(curDrawRef).IsRoundRect :=true;
            if isFill then
            begin
              TDrawRect(curDrawRef).BrushStyle :=bsSolid;
              TDrawRect(curDrawRef).BrushColor :=curFillColor;
            end;
          end;
    drwSanJiao:begin
            bDrawing:=true;
            curDrawRef:=TDrawSanJiao.create;
            iMoveMode:=TDrawSanJiao(curDrawRef).NewPoint(x,y);
            TDrawObject(curDrawRef).Style :=drwSanJiao;
            TDrawObject(curDrawRef).PenColor :=curForeColor;
           end;
    drwCircle:
         begin
          bDrawing:=true;
          curdrawRef:=TDrawCircle.create;
          iMoveMode:=TDrawCircle(curDrawRef).NewPoint(x,y);
          TDrawObject(curDrawRef).Style :=drwCircle;
          TDrawObject(curDrawRef).PenColor :=curForeColor;
          if isFill then
          begin
            TDrawCircle(curDrawRef).BrushStyle :=bsSolid;
            TDrawCircle(curDrawRef).BrushColor :=curFillColor;
          end;
         end;
    drwEllispe:
         begin
          bDrawing:=true;
          curDrawRef:=TDrawEllipse.create;
          iMoveMode:=TDrawEllipse(curDrawRef).NewPoint(x,y);
          TDrawObject(curDrawRef).Style :=drwEllispe;
          TDrawObject(curDrawRef).PenColor :=curForeColor;
          if isFill then
          begin
            TDrawEllipse(curDrawRef).BrushStyle :=bsSolid;
            TDrawEllipse(curDrawRef).BrushColor :=curFillColor;
          end;
         end;
    drwPLine:begin
         if curDrawRef<>nil then
         begin
           iMoveMode:=TDrawPline(curDrawRef).AddPoint(x,y);
         end
         else
         begin
           bDrawing:=true;
           curDrawRef:=TDrawPLine.create;
           iMoveMode:=TDrawPLine(curDrawRef).NewPoint(x,y);
           TDrawObject(curDrawRef).Style :=drwPLine;
           TDrawObject(curDrawRef).PenColor :=curForeColor;
         end;
    end;
    drwPolygon:begin
        if curDrawRef<>nil then
        begin
           iMoveMode:=TDrawPolygon(curDrawRef).AddPoint(x,y);
        end
        else
        begin
           bDrawing:=true;
           curDrawRef:=TDrawPolygon.create;
           iMoveMode:=TDrawPolygon(curDrawRef).NewPoint(x,y);
           TDrawObject(curDrawRef).Style :=drwPolygon;
           TDrawObject(curDrawRef).PenColor :=curForeColor;
           if isFill then
           begin
             TDrawPolygon(curDrawRef).BrushStyle :=bsSolid;
             TDrawPolygon(curDrawRef).BrushColor :=curFillColor;
           end;
        end;
    end;
    drwFreeLine:begin
           bDrawing:=true;
           curDrawRef:=TDrawFreeLine.create;
           iMoveMode:=TDrawFreeLine(curDrawRef).NewPoint(x,y);
           TDrawObject(curDrawRef).Style :=drwFreeLine;
           TDrawObject(curDrawRef).PenColor :=curForeColor;
    end;
    drwText:begin
       if curDrawRef<>nil then
       begin
         clipCursor(nil);
         txtSet(curDrawRef);
         if TDrawObject(CurDrawRef).isValid then
         begin
           tsDrwObjects.add(curDrawRef);
         end;
         draw_RamBitmap;
         bDrawing:=false;
         curDrawRef:=nil;
       end
       else
       begin
         bDrawing:=true;
         curDrawRef:=TDrawText.create;
         iMoveMode:=TDrawText(curDrawRef).NewPoint(x,y);
         TDrawObject(curDrawRef).Style:=drwText;
         TDrawText(curDrawRef).Font.Color :=curForeColor;
         TDrawText(curDrawRef).Font.Name :=curTextName;
         TDrawText(curDrawRef).Font.Size :=curTextSize;
         TDrawText(curDrawRef).Font.Style :=getFontStyle;
       end;
    end;
    drwImage:begin
       if curDrawRef<>nil then
       begin
         clipCursor(nil);
         dlgOpenBit.Filter :='Bmp(*.bmp);Jpeg(*.jpg);Ico(*.ico)|*.bmp;*.jpg;*.ico';
         if dlgOpenBit.Execute then
         begin
           TDrawImage(curDrawRef).LoadBitmap(dlgOpenBit.FileName);
           tsDrwObjects.Add(curDrawRef);
         end;
         draw_ramBitmap;
         curDrawRef:=nil;
         bDrawing:=false;
       end
       else
       begin
         bDrawing:=true;
         curDrawRef:=TDrawImage.create;
         iMoveMode:=TDrawImage(curDrawRef).NewPoint(x,y);
         TDrawImage(curDrawRef).Style :=drwImage;
         TDrawObject(curDrawRef).PenColor :=curForeColor;
       end;
    end;
  end;
  if not (drwTool in [drwImage,drwText,drwSelect]) and (curDrawRef<>nil) then
  TDrawObject(curDrawRef).PenWidth :=curPenWidth;  
  if curDrawRef<>nil then
  TDrawObject(curDrawRef).ZoomScale :=curZoomScale;
end;

procedure TfrmMain.MouseRightDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  isMove:=false;
  if curDrawRef=nil then exit;
  clipCursor(nil);
  case drwTool of
    drwPLine:begin
       if TDrawPLine(curDrawRef).m_number >1 then
       begin
          tsDrwObjects.Add(curDrawRef);
       end
       else
          tDrawPline(curDrawRef).Free;
       end;
    drwPolygon:begin
       if TDrawPolygon(curDrawRef).m_number >1 then
       begin
         tsDrwObjects.Add(curDrawRef);
       end
       else
       tDrawPolygon(curDrawRef).Free;
       end;
  end;
  bDrawing:=false;
  if drwTool<>drwSelect then
  begin
    curDrawRef:=nil;
    draw_RamBitmap;
  end;
 {弹出操作菜单}
  if drwTool=drwSelect then
  PopupMnu(round(x*curZoomScale),round(y*curZoomScale));
end;

procedure TfrmMain.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 TfrmMain.PopupMnu(x, y: integer);
var
 t:TPoint;
begin
 t:=Point(x,y);
 t:=drwPaint.ClientToScreen(t);
 drwPopMenu.Popup(t.X,t.y);
end;

procedure TfrmMain.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);
    end;
end;

procedure TfrmMain.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 TfrmMain.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,drwText,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 TfrmMain.setTextStatus;
{var
  i,j:integer;
  tmp:Pointer;}
begin
 { fontspin.Tag :=1;
  j:=0;
  if (tsSelection.Count >1) or (tsSelection.Count=0) then
     edtNumber.Enabled :=false
  else
  begin
     edtNumber.Enabled :=true;
     edtNumber.Text :=TDrawObject(tsSelection.Items[0]).Name;
  end;
  if tsSelection.Count >0 then
  begin
    for i:=0 to tsSelection.Count-1 do
    begin
      if TDrawObject(tsSelection.Items[i]).Style =drwText then
      begin
        j:=j+1;
        tmp:=tsSelection.Items[i];
      end;
    end;
  end;
  if (j>0) and (j<2) then
  begin
      选择一个文本图形时,则设置为当前选中文本的格式
      fontcom.ItemIndex :=FontCom.Items.IndexOf(TDrawText(tmp).Font.Name);
      fontspin.Value :=TDrawText(tmp).Font.Size;
      btnBold.Down:=TDrawText(tmp).isBold;
      btnItalic.Down :=TDrawText(tmp).isItaic;
      btnLine.Down :=TDrawText(tmp).isUnderLine;
  end;
  if j>1 then edtNumber.Clear;
  if (tsSelection.Count =0) or (j=0) then
  begin
    fontcom.ItemIndex :=FontCom.Items.IndexOf(curTextName);
    fontspin.Value :=curTextSize;
    btnBold.Down :=bFontBold;
    btnItalic.Down :=bFontItalic;
    btnLine.Down :=bFontUnderLine;
    if tsSelection.Count =0 then
    edtNumber.Clear;
  end; }
end;

procedure TfrmMain.writeObjectStream(f: TStream);
var
  i:integer;
begin
  if curDrawRef=nil then exit;
  if tsSelection.Count =0 then exit;
  for i:=0 to tsSelection.Count -1 do
  TDrawObject(tsSelection.Items[i]).Save(f);
end;

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