Delphi7 图像篇(三)

本实例主要用鼠标在窗体上绘图

用到组件有TBevel、TRadioGroup、TButton组件

运行效果如下:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, XPMan;

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    Button2: TButton;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    start:Boolean;
    OX,OY:Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  start:=true;
  case RadioGroup1.ItemIndex of
    0: ; //nothing
    1,2,3,4,
    5:  begin
          OX:=X;
          OY:=Y;
        end;
  end;
  Self.Canvas.MoveTo(X,Y);    //设置画笔的起始位置
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if start then
  begin
  case RadioGroup1.ItemIndex of   //根据TRadioGroup组件的索引号进行操作
    0: begin
         Canvas.Pen.Color := clWindowText;    //将画笔设置成黑色
         self.Canvas.LineTo(X,Y);        //鼠标移动时在窗体上画线
       end;
    1,2,3,4: Canvas.Pen.Color := clWindowText; //将画笔设置成黑色
    5: begin
         Canvas.Pen.Color := form1.Color;   //将画笔颜色设置成窗体颜色
         Canvas.Brush.Color := form1.Color; //将画刷颜色设置成窗体颜色
         Canvas.Rectangle(X-2,Y-2,X+2,Y+2); //对窗体进行擦除
       end;
  end;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  start:=false;
  case RadioGroup1.ItemIndex of 
    0: ;
    1:  Canvas.Arc(OX,OY,x,y,oX,oY,X,y);  //画弧形
    2:  Canvas.Ellipse(Rect(OX,OY,x,y));  //画椭圆
    3:  Canvas.Rectangle(OX,OY,x,y);      //画矩形
    4:  begin                 //画椭圆
            if abs(x-OX)<abs(y-OY) then
              Canvas.Ellipse(OX,OY,OX+abs(OX-x),OY+abs(OX-x))  //以X值的长度画椭圆
         else
              Canvas.Ellipse(OX,OY,OX+abs(OY-y),OY+abs(OY-y)); //以Y值的长度画椭圆
        end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  form1.canvas.FillRect(Rect(9,9,392,288));
end;

end.

 

posted @ 2014-11-05 13:11  Delphi爱好者2014  阅读(1765)  评论(0编辑  收藏  举报