⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_drwchild.pas

📁 delphi语言开发的矢量图形处理对象
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    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 TfrmDrw.drwPaintMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if bDrawing then
   begin
      if drwTool in [drwLine,drwRect,drwCircle,drwRectGraph,
      drwEllispe,drwArc,drwFreeLine,drwSanJiao,drwLineGraph,drwGrid] then
      begin
        clipCursor(nil);//恢复鼠标范围的限制
        if TDrawObject(curDrawRef).IsValid then
        begin
          tsDrwObjects.Add(curDrawRef);
          if drwTool in [drwRectGraph,drwLineGraph] then
            draw_RamBitmap//在内存中重画图形,在拷贝到当前画布
          else
            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 TfrmDrw.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 TfrmDrw.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;
      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;//设置文字的修饰格式的状态
  frmMain.fontspin.Tag :=0;
end;

procedure TfrmDrw.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;
           {判断是否进行整体托动}
          { if tsSelection.Count >1 then
           begin
              for i:=0 to tsSelection.Count -1 do
              begin
                if TDrawObject(tsSelection.Items[i]).SelectAt(x,y)<>-1 then
                exit;
              end;
           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;
    drwLineGraph:begin
            bDrawing:=true;
            curDrawRef:=TDrawLineGraph.create;
            iMoveMode:=TDrawLineGraph(curDrawRef).NewPoint(x,y);
            TDrawObject(curDrawRef).Style :=drwLineGraph;
            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;
    drwRectGraph:begin
            bDrawing:=true;
            curDrawRef:=TDrawRectGraph.create;
            iMoveMode:=TDrawRectGraph(curDrawRef).NewPoint(x,y);
            TDrawObject(curDrawRef).Style :=drwRectGraph;
           end;
    drwSanJiao:begin
            bDrawing:=true;
            curDrawRef:=TDrawSanJiao.create;
            iMoveMode:=TDrawSanJiao(curDrawRef).NewPoint(x,y);
            TDrawObject(curDrawRef).Style :=drwSanJiao;
            TDrawObject(curDrawRef).PenColor :=curForeColor;
           end;
    drwGrid:begin
            bDrawing:=true;
            curDrawRef:=TDrawGrid.create;
            iMoveMode:=TDrawGrid(curDrawRef).NewPoint(x,y);
            TDrawObject(curDrawRef).Style :=drwGrid;
            TDrawObject(curDrawRef).PenColor :=curForeColor;
            TDrawGrid(curDrawRef).BrushColor :=curFillColor;
            TDrawGrid(curDrawRef).BrushStyle :=bsSolid;
            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;
    drwYc:begin
         bDrawing:=true;
         curDrawRef:=TDrawYcText.create;
         iMoveMode:=TDrawYcText(curDrawRef).NewPoint(x,y);
         TDrawObject(curDrawRef).Style:=drwYc;
         TDrawYcText(curDrawRef).Font.Color :=curForeColor;
         TDrawYcText(curDrawRef).Font.Name :=curTextName;
         TDrawYcText(curDrawRef).Font.Size :=curTextSize;
         TDrawYcText(curDrawRef).Font.Style :=getFontStyle;
         clipCursor(nil);
         tsDrwObjects.add(curDrawRef);
         draw_RamBitmap;
         bDrawing:=false;
         curDrawRef:=nil;
    end;

    drwCurve:begin
         bDrawing:=true;
         curDrawRef:=TDrawCurveText.create;
         iMoveMode:=TDrawCurveText(curDrawRef).NewPoint(x,y);
         TDrawObject(curDrawRef).Style:=drwCurve;
         TDrawCurveText(curDrawRef).Font.Color :=curForeColor;
         TDrawCurveText(curDrawRef).Font.Name :=curTextName;
         TDrawCurveText(curDrawRef).Font.Size :=curTextSize;
         TDrawCurveText(curDrawRef).Font.Style :=getFontStyle;
         clipCursor(nil);
         tsDrwObjects.add(curDrawRef);
         draw_RamBitmap;
         bDrawing:=false;
         curDrawRef:=nil;
    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 TfrmDrw.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;
    else begin
       if bDrawing then
       TDrawObject(curDrawRef).Free;
    end;
  end;
  bDrawing:=false;
  if drwTool<>drwSelect then
  begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -