mainform.pas

delphi com深入编程,非常有收藏价值

unit MainForm;

interface

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

type
  TForm1 = class(TForm)
    btnNewSquare: TButton;
    btnNewMark: TButton;
    btnClear: TButton;
    btnNudgeLeft: TButton;
    btnNudgeRight: TButton;
    btnNudgeUp: TButton;
    btnNudgeDown: TButton;
    btnGrow: TButton;
    Bevel1: TBevel;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnNewSquareClick(Sender: TObject);
    procedure btnNewMarkClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnNudgeLeftClick(Sender: TObject);
    procedure btnNudgeRightClick(Sender: TObject);
    procedure btnNudgeUpClick(Sender: TObject);
    procedure btnNudgeDownClick(Sender: TObject);
    procedure btnGrowClick(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
    FShapes: TInterfaceList;
    procedure Clear;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Shapes;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FShapes := TInterfaceList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Clear;

  FShapes.Free;
end;

procedure TForm1.btnNewSquareClick(Sender: TObject);
var
  Square: IUnknown;
begin
  Square := TSquare.Create(Point(10 + Random(200), 10 + Random(200)),
    40 + Random(20), 40 + Random(20), clBlack);
  FShapes.Add(Square);

  PaintBox1.Invalidate;
end;

procedure TForm1.btnNewMarkClick(Sender: TObject);
var
  Mark: IUnknown;
begin
  Mark := TMark.Create(Point(10 + Random(200), 10 + Random(200)),
    clBlue);
  FShapes.Add(Mark);

  PaintBox1.Invalidate;
end;

procedure TForm1.Clear;
begin
  // TInterfaceList.Clear automatically releases all of the
  // interfaces destroyed in the list.
  FShapes.Clear;
end;

procedure TForm1.btnClearClick(Sender: TObject);
begin
  Clear;

  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  Index: Integer;
  Shape: IUnknown;
begin
  for Index := 0 to FShapes.Count - 1 do begin
    Shape := FShapes[Index];

    (Shape as IDraw).Draw(PaintBox1.Canvas);
  end;
end;

procedure TForm1.btnNudgeLeftClick(Sender: TObject);
var
  Index: Integer;
  Shape: IUnknown;
begin
  for Index := 0 to FShapes.Count - 1 do begin
    Shape := IUnknown(FShapes[Index]);

    (Shape as IPosition).NudgeLeft;
  end;

  PaintBox1.Invalidate;
end;

procedure TForm1.btnNudgeRightClick(Sender: TObject);
var
  Index: Integer;
  Shape: IUnknown;
begin
  for Index := 0 to FShapes.Count - 1 do begin
    Shape := IUnknown(FShapes[Index]);

    (Shape as IPosition).NudgeRight;
  end;

  PaintBox1.Invalidate;
end;

procedure TForm1.btnNudgeUpClick(Sender: TObject);
var
  Index: Integer;
  Shape: IUnknown;
begin
  for Index := 0 to FShapes.Count - 1 do begin
    Shape := IUnknown(FShapes[Index]);

    (Shape as IPosition).NudgeUp;
  end;

  PaintBox1.Invalidate;
end;

procedure TForm1.btnNudgeDownClick(Sender: TObject);
var
  Index: Integer;
  Shape: IUnknown;
begin
  for Index := 0 to FShapes.Count - 1 do begin
    Shape := IUnknown(FShapes[Index]);

    (Shape as IPosition).NudgeDown;
  end;

  PaintBox1.Invalidate;
end;

procedure TForm1.btnGrowClick(Sender: TObject);
var
  Index: Integer;
  Shape: IUnknown;
  SizeIntf: ISize;
begin
  for Index := 0 to FShapes.Count - 1 do begin
    Shape := IUnknown(FShapes[Index]);

    if Shape.QueryInterface(ISize, SizeIntf) = S_OK then begin
      SizeIntf.Width := SizeIntf.Width + 1;
      SizeIntf.Height := SizeIntf.Height + 1;
    end;
  end;

  PaintBox1.Invalidate;
end;

end.