VCL画图实例

代码下载：

https://download.csdn.net/download/zhujianqiangqq/12394576

 

代码实例：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
  TCanvasData = record  //定义绘制数据数组
    //画笔可设置的参数
    PenStartSize: Integer;      //画笔开始大小
    PenMinSize: Integer;        //画笔最小大小
    PenMaxSize: Integer;        //画笔最大大小
    PenMobileBorder: Integer;   //移动界限，超过这个值就改变笔大小值
    PenChangeValue: Integer;    //画笔每次改变的大小
    PenSizeChangeSpeed: Integer;//笔的改变速度，越小改变的速度越快
    //画图用到的参数
    PenCurrentSize: Integer;    //画笔当前大小
    PenLastPoint: TPoint;       //画笔最后的点
    PenMobileDistance: TPoint;  //画笔移动了多少距离
    MouseDownTab:Boolean;       //鼠标按下标记
    Yadd:Integer;
  end;

type
  TForm1 = class(TForm)
    LEPenStartSize: TLabeledEdit;
    LEPenChangeValue: TLabeledEdit;
    LEPenMinSize: TLabeledEdit;
    LEPenMaxSize: TLabeledEdit;
    LEPenMobileBorder: TLabeledEdit;
    LEPenSizeChangeSpeed: TLabeledEdit;
    IMCanvas: TImage;
    Timer1: TTimer;
    IMOriginal: TImage;
    Button1: TButton;
    procedure LEPenStartSizeKeyPress(Sender: TObject; var Key: Char);
    procedure LEPenStartSizeMouseLeave(Sender: TObject);
    procedure LEPenStartSizeChange(Sender: TObject);
    procedure IMCanvasMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure IMCanvasMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure IMCanvasMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MYCanvasData: TCanvasData;//定义画笔数据变量

implementation
uses Winapi.GDIPAPI, Winapi.GDIPOBJ{, Winapi.GDIPUTIL};
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  IMCanvas.Picture := nil;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IMOriginal.Height := IMCanvas.Height;
  IMOriginal.Width := IMCanvas.Width;
  IMOriginal.Top := 0;
  IMOriginal.Left := 0;
  IMOriginal.SendToBack;

  LEPenStartSize.Text  := '5';
  LEPenMinSize.Text    := '4';
  LEPenMaxSize.Text    := '10';
  LEPenMobileBorder.Text    := '5';
  LEPenChangeValue.Text     := '1';
  LEPenSizeChangeSpeed.Text := '3';

  MYCanvasData.PenStartSize := 5;
  MYCanvasData.PenMinSize   := 4;
  MYCanvasData.PenMaxSize   := 10;
  MYCanvasData.PenMobileBorder := 5;
  MYCanvasData.PenChangeValue  := 1;
  MYCanvasData.PenSizeChangeSpeed  := 3;

  LEPenStartSize.OnChange := LEPenStartSizeChange;
  LEPenMinSize.OnChange   := LEPenStartSizeChange;
  LEPenMaxSize.OnChange   := LEPenStartSizeChange;
  LEPenMobileBorder.OnChange    := LEPenStartSizeChange;
  LEPenChangeValue.OnChange     := LEPenStartSizeChange;
  LEPenSizeChangeSpeed.OnChange := LEPenStartSizeChange;
end;

procedure TForm1.LEPenStartSizeChange(Sender: TObject);
begin
  MYCanvasData.PenStartSize := StrToInt(LEPenStartSize.Text);   //开始笔头大小
  MYCanvasData.PenMinSize   := StrToInt(LEPenMinSize.Text);     //最小笔头
  MYCanvasData.PenMaxSize   := StrToInt(LEPenMaxSize.Text);     //最大笔头
  MYCanvasData.PenMobileBorder := StrToInt(LEPenMobileBorder.Text);    //移动距离  超过值时 改变笔头大小
  MYCanvasData.PenChangeValue  := StrToInt(LEPenChangeValue.Text);     //每次大小变动的单位
  MYCanvasData.PenCurrentSize  := StrToInt(LEPenSizeChangeSpeed.Text); //笔头 大小 改变的速度  越小速度越快
end;

procedure TForm1.LEPenStartSizeKeyPress(Sender: TObject; var Key: Char);
begin
  if not ((Key in ['0'..'9']) or (Key=#8)) then  Key:=#0;
end;

procedure TForm1.LEPenStartSizeMouseLeave(Sender: TObject);
begin
  if Length((Sender as TLabeledEdit).Text)<1 then (Sender as TLabeledEdit).Text:='1';
end;

procedure TForm1.IMCanvasMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case Button of
    mbLeft:begin
             MYCanvasData.PenCurrentSize := MYCanvasData.PenStartSize;
             MYCanvasData.PenMobileDistance.X := -1;
             MYCanvasData.PenLastPoint.X := X;
             MYCanvasData.PenLastPoint.Y := Y;
//             Yadd:=1;
             MYCanvasData.MouseDownTab := True;
           end;
    mbRight: ;
    mbMiddle:;
  end;
end;


procedure TForm1.IMCanvasMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  graphics: TGPGraphics;
  pen: TGPPen;
begin
  Form1.Caption:='当前笔头大小:' + IntToStr(MYCanvasData.PenCurrentSize);
  if MYCanvasData.MouseDownTab then
  begin
    graphics := TGPGraphics.Create(Canvas.Handle);
    try
      pen := TGPPen.Create(aclBlack, MYCanvasData.PenCurrentSize);
      try
        pen.SetStartCap(LineCapRound); //设置线帽，让线看起来更圆润
        pen.SetEndCap(LineCapRound);
        graphics.SetSmoothingMode(SmoothingModeHighQuality); //抗锯齿
        graphics.DrawLine(pen, MYCanvasData.PenLastPoint.X, MYCanvasData.PenLastPoint.Y, X, Y); //画线
        MYCanvasData.PenLastPoint.X := X;
        MYCanvasData.PenLastPoint.Y := Y;
      finally
        pen.Free;
      end;
    finally
      graphics.Free;
    end;
  end;
end;

procedure TForm1.IMCanvasMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case Button of
    mbLeft: MYCanvasData.MouseDownTab := False;
    mbRight: ;
    mbMiddle:;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if  MYCanvasData.MouseDownTab then
  Begin
    if MYCanvasData.PenMobileDistance.X > -1 then
    begin
      Inc(MYCanvasData.Yadd);
      if (Abs(MYCanvasData.PenMobileDistance.X - MYCanvasData.PenLastPoint.X) < MYCanvasData.PenMobileBorder) and
         (Abs(MYCanvasData.PenMobileDistance.Y - MYCanvasData.PenLastPoint.Y) < MYCanvasData.PenMobileBorder) then
      Begin
        if (MYCanvasData.Yadd >= MYCanvasData.PenSizeChangeSpeed) then
          if (MYCanvasData.PenCurrentSize < MYCanvasData.PenMaxSize) then
          begin
            MYCanvasData.PenCurrentSize := MYCanvasData.PenCurrentSize + MYCanvasData.PenChangeValue;
            MYCanvasData.Yadd:=1;
          end;
      end
      else
      begin
        if (MYCanvasData.Yadd >= MYCanvasData.PenSizeChangeSpeed) then
          if (MYCanvasData.PenCurrentSize > MYCanvasData.PenMinSize) then
          begin
            MYCanvasData.PenCurrentSize := MYCanvasData.PenCurrentSize - MYCanvasData.PenChangeValue;
            MYCanvasData.Yadd := 1;
          end;
      end;
    end;
    MYCanvasData.PenMobileDistance.X := MYCanvasData.PenLastPoint.X;
    MYCanvasData.PenMobileDistance.Y := MYCanvasData.PenLastPoint.Y;
  End;
end;


end.