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

📄 textpic.pas

📁 用Delphi画矢量图
💻 PAS
📖 第 1 页 / 共 3 页
字号:
         end;
     POS_LEFTCENTER: //      :Integer = 8  ; //左中
         begin
           //清除前一次
           mouseDiffX := mouseOldX - mouseDownOldX;
           //mouseDiffY := mouseOldY - mouseDownOldY;
           //绘制图元
           tempStartPoint.X:=StartPos.X+MouseDiffX;
           tempStartPoint.Y:=StartPos.Y;
           tempendPoint:=endpos;
           ChangPointXY;
           //绘制当前虚线图元
           mouseDiffX := mouseX - mouseDownOldX;
           //mouseDiffY := mouseY - mouseDownOldY;
           //绘制图元
           tempStartPoint.X:=StartPos.X+MouseDiffX;
           tempStartPoint.Y:=StartPos.Y;
           tempendPoint:=endpos;
           //坐标变换
           ChangPointXY;
         end;
     POS_CENTER: //         :Integer = 9  ; //矩形中央
         begin
           //绘制图元
           mouseDiffX := mouseOldX - mouseDownOldX;
           mouseDiffY := mouseOldY - mouseDownOldY;
           tempStartPoint :=Point( startPos.x + mouseDiffX,startPos.y + mouseDiffY);
           tempEndPoint := Point( endPos.x + mouseDiffX,endPos.y + mouseDiffY);
           ChangPointXY;
           //绘制当前虚线图元
           mouseDiffX := mouseX - mouseDownOldX;
           mouseDiffY := mouseY - mouseDownOldY;
           //绘制图元
           tempStartPoint :=Point(startPos.x + mouseDiffX, startPos.y + mouseDiffY);
           tempEndPoint := Point(endPos.x + mouseDiffX,endPos.y + mouseDiffY);
           //坐标变换
           ChangPointXY;
         end;
  end;
end;

procedure TTextPic.PicChangedUpdate(ACanvas:TCanvas; mouseInPos: MOUSE_POS;chooseRect: TRect; //选择图元形成的矩形
        mouseDownOldX, mouseDownOldY: Integer; mouseX, mouseY: Integer);//鼠标当前的坐标
var
  tmprect:TRect;
  MouseDiffX,MouseDiffY:Integer;
  FontTag:Integer;
begin
  //初始化
  FontTag:=0;
  fCanvas:=aCanvas;
  ACanvas.Pen.Width := 1;
  ACanvas.Pen.Mode := pmXor;
  ACanvas.Pen.Style := psDot;
  ACanvas.Brush.Style := bsClear;
  ACanvas.Rectangle(oldsp.X,oldsp.Y,oldep.X,oldep.Y);
  //计算选择图元的宽度和高度
  MouseDiffX:=Mousex-MouseDownOldX;
  MouseDiffY:=MouseY-MouseDownOldY;
  case mouseInPos of
    POS_LEFTTOP: //           :Integer = 1  ; //左上
      begin
        //确定基准点
        {if (ssCtrl in RectKeyState) then begin
          StartPos:=Point(Mousex,mouseY);
          EndPos.X:=EndPos.X-MouseDiffX;
          EndPos.Y:=EndPos.Y-MouseDiffY;
        end else begin }
          Inc(startPos.x, MouseDiffX);
          Inc(startPos.y, MousediffY);
        //end;
        FontTag:=3;
      end;
    POS_RIGHTTOP: //        :Integer = 2  ; //右上
      begin
        //确定基准点
        {if (ssCtrl in RectKeyState) then begin
          StartPos.X:=StartPos.X-MouseDiffX;
          StartPos.Y:=MouseY;
          EndPos.X:=MouseX;
          EndPos.Y:=EndPos.Y-MouseDiffY;
        end else begin }
          Inc(startPos.y, MouseDiffY);
          Inc(endPos.x, MouseDiffX);
        //end;
        FontTag:=3;
      end;
    POS_RIGHTBOTTOM: //     :Integer = 3  ; //右下
      begin
        {if (ssCtrl in RectKeyState) then begin
          StartPos.X:=StartPos.X-MouseDiffX;
          StartPos.Y:=StartPos.Y-MouseDiffY;
          EndPos.X:=MouseX;
          EndPos.Y:=MouseY;
        end else begin }
          Inc(endPos.x, mouseX - mouseDownOldX);
          Inc(endPos.y, mouseY - mouseDownOldY);
        //end;
        FontTag:=3;
      end;
    POS_LEFTBOTTOM: //      :Integer = 4  ; //左下
      begin
        {if (ssCtrl in RectKeyState) then begin
          StartPos.X:=MouseX;
          StartPos.Y:=StartPos.Y-MouseDiffY;
          EndPos.X:=EndPos.X-MouseDiffX;
          EndPos.Y:=MouseY;
        end else begin }
          Inc(startPos.x, mouseX - mouseDownOldX);
          Inc(endPos.Y, mouseY - mouseDownOldY);
        //end;
        FontTag:=3;
      end;
    POS_CENTERTOP: //       :Integer = 5  ; //上中
      begin
        {if (ssCtrl in RectKeyState) then begin
          StartPos.Y:=MouseY;
          EndPos.Y:=EndPos.Y-MouseDiffY;
        end else begin }
          Inc(startPos.Y, mouseY - mouseDownOldY);
        //end;
        FontTag:=2;
      end;
    POS_RIGHTCENTER: //      :Integer = 6  ; //右中
      begin
        {if (ssCtrl in RectKeyState) then begin
          StartPos.X:=StartPos.X-MouseDiffX;
          EndPos.X:=EndPos.X+MouseDiffX;
        end else begin }
          Inc(endPos.X, mouseX - mouseDownOldX);
        //end;
        FontTag:=1;
      end;
    POS_CENTERBUTTOM: //     :Integer = 7  ; //下中
      begin
        {if (ssCtrl in RectKeyState) then begin
          StartPos.Y:=StartPos.Y-MouseDiffY;
          EndPos.Y:=MouseY;
        end else begin }
          Inc(endPos.Y, mouseY - mouseDownOldY);
        //end;
        FontTag:=2;
      end;
    POS_LEFTCENTER: //      :Integer = 8  ; //左中
      begin
        {if (ssCtrl in RectKeyState) then begin
          StartPos.X:=StartPos.X+MouseDiffX;
          EndPos.X:=EndPos.X-MouseDiffX;
        end else begin  }
          Inc(StartPos.X, mouseX - mouseDownOldX);
        //end;
        FontTag:=1;
      end;
    POS_CENTER: //         :Integer = 9  ; //矩形中央
      begin
        Inc(startPos.x, mouseX - mouseDownOldX);
        Inc(startPos.y, mouseY - mouseDownOldY);
        Inc(endPos.x,   mouseX - mouseDownOldX);
        Inc(endPos.y,   mouseY - mouseDownOldY);
        FontTag:=0;
      end;
  end;
  //统一调整图元矩形区域和起点和终点的位置
  //保证起点坐标小于终点坐标
  with tmpRect do  begin //调整图元矩形区域
    Left := Min(startPos.x, endPos.x);
    Top := Min(startPos.y, endpos.Y);
    Right := Max(startPos.x, endPos.x);
    Bottom := Max(startPos.y, endPos.y);
    if Right = Left then  Inc(Right, 2);
    if Top = Bottom then   Inc(Bottom, 2);
    //更新坐标点
    PicFont.Size:=GetRectMaxFontSize(tmprect,fText.Text,PicFont,FontTag);
    EndPos.X:=StartPos.X+GetCanvasTextWidth(fText.Text,PicFont,True);
    EndPos.Y:=StartPos.Y+GetCanvasTextWidth(fText.Text,PicFont,False);
  end;
  SetTextPicRect(StartPos,EndPos);
end;

//位置代码可参见 PicConst.pas
procedure TTextPic.AssignPic(SourcePic: TPicBase);
begin
  inherited AssignPic(SourcePic);
  StartPos := TTextPic(SourcePic).PicStartPoint;
  EndPos := TTextPic(SourcePic).PicEndPoint;
  fText  :=TTextPic(SourcePic).Text;     //文字内容
  fHollow:=TTextPic(SourcePic).Hollow;          //空心
  fSided :=TTextPic(SourcePic).Sided;  //轮廓
  fView3D:=TTextPic(SourcePic).View3D;  //3D效果
  fBkColor:=TTextPic(SourcePic).BkColor;  //背景颜色
  fCanvas:=TTextPic(SourcePic).Canvas;
  fEditParent:=TTextPic(SourcePic).EditParent;
end;

//非重载函数
//绘图函数
procedure TTextPic.DrawTextPic(ACanvas: TCanvas; startPoint:TPoint; endPoint:TPoint);
begin
  if fText.Text='' then Exit;
  fTextbmp.Width:=EndPoint.X-StartPoint.X+1;
  fTextBmp.Height:=EndPoint.Y-StartPoint.Y+1;
  //清除原来画面的内容
  FTextbmp.Canvas.Brush.Color:=clBlack;
  fTextBmp.Canvas.Brush.Style:=bsSolid;
  fTextbmp.Canvas.FillRect(Rect(0,0,fTextbmp.Width,fTextbmp.Height));
  //重新画图
  FTextbmp.Canvas.Brush.Color:=PicBrush.Color;
  fTextBmp.Canvas.Brush.Style:=PicBrush.Style;
  fTextbmp.Canvas.FillRect(Rect(0,0,fTextbmp.Width,fTextbmp.Height));

  FtextBmp.Canvas.Font:=PicFont;
  ftextbmp.Canvas.Pen:=PicPen;
  fTextbmp.Canvas.Brush:=PicBrush;
  fTextbmp.Canvas.Brush.Style:=bsClear;
  fTextbmp.Canvas.TextOut(1,1,fText.Text);
  if fHollow then FreeFontInSide(fTextbmp);         //空心
  if fSided  then LineFontOutSide(fTextbmp);         //边框
  if fView3D then View3dFont(fTextbmp);         //3D效果
  DrawBitmapToCanvas(ACanvas,Rect(StartPoint,endPoint));
  PicId:=PIC_TEXT;
end;

procedure TTextPic.GetClassDataFromChar(var Len:Integer; var Buf:Array of Char);
var
  op,P:Pointer;
  oLen:Integer;
  fn:String;
  fl,i1:Integer;
begin
  inherited GetClassDataFromChar(Len,Buf);
  olen:=Len;
  p:=Pointer(@Buf[Len]);
  op:=p;
  StartPos.X:=PInteger(P)^;
  Inc(PInteger(P));
  StartPos.Y:=PInteger(P)^;
  Inc(PInteger(P));
  EndPos.X:=PInteger(P)^;
  Inc(PInteger(P));
  EndPos.Y:=PInteger(P)^;
  Inc(PInteger(P));
  fl:=PInteger(P)^;
  Inc(PInteger(P));
  fn:='';
  for i1:=1 to fl do begin
    fn:=fn+Chr(PByte(P)^);
    Inc(PByte(P));
  end;
  fText.Text:=fn;
  fHollow:=Boolean(PByte(P)^);
  Inc(PByte(P));
  fSided:=Boolean(PByte(P)^);
  Inc(PByte(P));
  fView3D:=Boolean(PByte(P)^);
  Inc(PByte(P));
  fBkColor:=PInteger(P)^;
  Inc(PInteger(P));
  //Len:=oLen+AddrOffSet(op,P);
  Len:=oLen+LongInt(P)-LongInt(Op);
end;

procedure TTextPic.SaveClassDataToChar(var Len:Integer; var Buf:Array of Char);
var
  op,P:Pointer;
  oLen:Integer;
  i1,fl:Integer;
  fn:String;
begin
  inherited SaveClassDataToChar(Len,Buf);
  olen:=Len;
  p:=Pointer(@Buf[Len]);
  op:=p;
  PInteger(P)^:=StartPos.X;
  Inc(PInteger(P));
  PInteger(P)^:=StartPos.Y;
  Inc(PInteger(P));
  PInteger(P)^:=EndPos.X;
  Inc(PInteger(P));
  PInteger(P)^:=EndPos.Y;
  Inc(PInteger(P));
  fn:=fText.Text;
  fl:=Length(fn);
  PInteger(P)^:=fl;
  Inc(PInteger(P));
  for i1:=1 to fl do begin
    PByte(P)^:=Ord(fn[i1]);
    Inc(PByte(P));
  end;
  PByte(P)^:=Byte(fHollow);
  Inc(PByte(P));
  PByte(P)^:=Byte(fSided);
  Inc(PByte(P));
  PByte(P)^:=Byte(fView3D);
  Inc(PByte(P));
  PInteger(P)^:=fBkColor;
  Inc(PInteger(P));
  //Len:=oLen+AddrOffSet(op,P);
  Len:=oLen+LongInt(P)-LongInt(Op);
end;

end.

⌨️ 快捷键说明

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