Tips (1541)

Tip Bewertung (60):

{This code show how you can create an array of shapes at runtime inside a panel,
and while you don't release the mouse button you can change the size of the shape,
you can put some buttons in order to define the shape (circle, rectangle, etc.
here I only show two of them, maybe it's not so usefull, but fun}


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var 
  forma: array of TShape;    //Array to create
  formaUtil: Integer;        // Kind of shape
  Numforma: Integer;         //Number of shapes
  Izq, Arr, Ancho, alto, x1, x2, y1, y2: Integer; //Position and size of shape
  activar: Boolean;          //Tells when you are creating and sizing the shape

procedure TForm1.Button1Click(Sender: TObject);
begin
  formaUtil := 1;   //rectangle
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  formaUtil := 2;   //circle
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  formaUtil := 0;
  Numforma := 0;
  activar := False;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if formaUtil < 1 then Exit;
  activar  := True;              //starting draw the shape
  x1 := x;
  y1 := y;
  numforma := numforma + 1;
  setlength(forma, numforma);
  forma[numforma - 1] := TShape.Create(Panel1);
  if formaUtil = 1 then
    forma[numforma - 1].Shape := stRectangle
  else
    forma[numforma - 1].Shape := stCircle;
  forma[numforma - 1].Left   := x1;
  forma[numforma - 1].Top    := y1;
  forma[numforma - 1].Parent := Panel1;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  x2 := x;
  y2 := y;
  forma[numforma - 1].Width := x2 - x1;
  forma[numforma - 1].Height := y2 - y1;
  formaUtil := 0;
  activar   := False;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (formaUtil = 0) then Exit;
  if (numforma = 0) then Exit;
  if not activar then Exit;
  x2 := x;
  y2 := y;
  forma[numforma - 1].Width := x2 - x1;
  forma[numforma - 1].Height := y2 - y1;
end;

end.