如何实现在Image上绘制不同笔迹的线条!!顶贴有分！

winder_008 2008-10-16 11:23:18

绘制钢笔毛笔等不同的形状，而且对虚线也可以绘制。笔宽可以设定！！不够开贴再加！！

...全文

186 13 打赏收藏转发到动态举报

写回复

用AI写文章

13 条回复

切换为时间正序

请发表友善的回复…

发表回复

winder_008 2008-10-28

打赏
举报

to 楼上：

你的加载 //如果画刷是位图,就可以绘位图,比如毛笔位图,Image1.Canvas.FillRect(Rect(x1,y1,x2,y2));
能不能说的更清楚些，其他画线的方式我都可以实现，关键是实现这种特殊笔触的效果不知道如何实现！！

winder_008 2008-10-21

打赏
举报

服了CSDN了！！

天行归来 2008-10-21

打赏
举报

随手写了点，希望对你有所帮助。

procedure TForm1.FormCreate(Sender: TObject);

begin

  //初始化: 绘制白色背景

  Image1.Tag := 0;

  Image1.Canvas.Brush.Color := clWhite;

  Image1.Canvas.FillRect(Rect(0,0,Image1.Width-1,Image1.Height-1));

end;



procedure TForm1.btnSolidPenClick(Sender: TObject);

begin

  Image1.Canvas.Pen.Style  := psSolid; //实线

  Image1.Canvas.Pen.Width  := 2;       //线宽

end;



procedure TForm1.btnDotClick(Sender: TObject);

begin

  Image1.Canvas.Pen.Style  := psDot	;   //虚线

  Image1.Canvas.Pen.Width  := 2;       //线宽

end;



procedure TForm1.btnBitmapClick(Sender: TObject);

var

  bitmap: TBitmap;

begin

  Bitmap := TBitmap.Create;

  Bitmap.LoadFromFile('c:\tmp.bmp');

  Image1.Canvas.Brush.Bitmap := bitmap;

  //绘图时,可以用   Image1.Canvas.FillRect(Rect(x1,y1,x2,y2));

  Bitmap.Free;

end;



procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

  //in drawing

  Image1.Tag := 1;

  Image1.Canvas.MoveTo(x,y); //画线

  //如果画刷是位图,就可以绘位图,比如毛笔位图,Image1.Canvas.FillRect(Rect(x1,y1,x2,y2));

end;



procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

  //ready to draw

  if Image1.Tag=1 then Image1.Canvas.LineTo(X,Y);

end;



procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

  //end draw

  Image1.Tag := 0;

end;