unit1.pas

Delphi7应用编程150例附书源码.rar

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Flag:Boolean;
  PointX,PointY:Integer;
  ShapeArray: array of TShape;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    Flag:=false;
    self.DoubleBuffered:=true;
    //防止绘图时闪烁
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    TempShape:TShape;
    NewX,NewY:Integer;
begin
    if (Sender is TShape) then
    begin
        NewX:=X+(Sender as TShape).Left;
        NewY:=Y+(Sender as TShape).Top;
    end
    else
    begin
        NewX:=X;
        NewY:=Y;
    end;

    Flag:=true;
    PointX:=NewX;
    PointY:=NewY;
    TempShape:=TShape.Create(self);
    TempShape.Parent:=self;
    TempShape.Visible:=True;
    TempShape.Left:=NewX;
    TempShape.Top:=NewY;
    TempShape.Width:=0;
    TempShape.Height:=0;
    TempShape.Brush.Style:=bsClear;
    TempShape.OnMouseDown:=self.OnMouseDown;
    TempShape.OnMouseMove:=self.OnMouseMove;
    TempShape.OnMouseUp:=self.OnMouseUp;  

    SetLength(ShapeArray,Length(ShapeArray)+1);
    ShapeArray[Length(ShapeArray)-1]:=TempShape;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
    i:Integer;
    TempShape:TShape;
begin
    for i:=0 to Length(ShapeArray)-1 do
    begin
        TempShape:=ShapeArray[i];
        TempShape.Free;
    end;
    SetLength(ShapeArray,0);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
    NewX,NewY:Integer;
begin
    if Flag then
    begin
        if (Sender is TShape) then
        begin
            NewX:=X+(Sender as TShape).Left;
            NewY:=Y+(Sender as TShape).Top;
        end
        else
        begin
            NewX:=X;
            NewY:=Y;
        end;
        ShapeArray[Length(ShapeArray)-1].Width:=NewX-ShapeArray[Length(ShapeArray)-1].Left;
        ShapeArray[Length(ShapeArray)-1].Height:=NewY-ShapeArray[Length(ShapeArray)-1].Top;
    end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    Flag:=false;
end;

end.