paint.~pas

本光盘是《Delphi 7应用教程》一书的配套光盘

unit Paint;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
//    procedure Button3Click(Sender: TObject);
 //   procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
   StartPt,EndPt:TPoint;
   Capture:boolean;
   shapekind:integer;    //表示画图的种类，1表示椭圆，2表示矩形
{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
      StartPt.x:=x;       //设定起始点
      StartPt.Y:=y;
      EndPt:=StartPt;    
      Capture:=True;       //捕获鼠标操作
      With Image1.Canvas   do
      begin
          pen.Mode:=pmNot;   //设定的画笔的模式为pmNot，两次画同一点，等于没有画
          Pen.Color:=clBlack;   //画笔的颜色为黑色
          Brush.Style:=bsClear; //画刷的填充风格为无
      end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);   //在该事件中消除上一次的轮廓线，画本次轮廓线
begin
    if(Capture)and((EndPt.x<>x)or(EndPt.Y<>Y)) Then//如果鼠标发生了移动
        Begin
           case Shapekind  Of   //判断要画的是哪一种图形
               1: begin
                    Image1.Canvas.Ellipse(StartPt.X,StartPt.Y,EndPt.X,EndPt.Y );//擦除刚才的椭圆轮廓
                    Image1.Canvas.Ellipse(StartPt.X,StartPt.Y,x,y); //重画新的椭圆轮廓
                  end;
               2: begin
                    Image1.Canvas.Rectangle(StartPt.X,StartPt.Y,EndPt.X,EndPt.Y );//擦除刚才的矩形轮廓
                    Image1.Canvas.Rectangle(StartPt.X,StartPt.Y,x,y); //重画新的矩形轮廓
                  end;
            end;
           EndPt.x:=x; //设置新的结束点位置
           EndPt.Y:=y;
       end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer); //消除最后的轮廓线并画出需要的图形
begin
  Capture:=False;//取消对鼠标的捕获
  With Image1.Canvas  do
     begin
        case Shapekind  Of  //判断要画的是哪一种图形，并把鼠标轮廓线去除
               1:  Ellipse(StartPt.X,StartPt.Y,EndPt.X,EndPt.Y );
               2:  Rectangle(StartPt.X,StartPt.Y,EndPt.X,EndPt.Y );
        end;
        Pen.Mode:=pmCopy;//设置画笔的模式
        Brush.Color:=clBlue;  //设置画刷的填充色为蓝色
        Brush.Style:=bsSolid;
        case Shapekind  Of   //判断要画的图形种类，绘制出需要的图形
               1:  Ellipse(StartPt.X,StartPt.Y,X,Y );
               2:  Rectangle(StartPt.X,StartPt.Y,X,Y );
        end;
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ShapeKind:=1;  //开始认为要画的图形为椭园
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
   Shapekind:=1; //画椭园
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  Shapekind:=2;  //画矩形
end;




end.