whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

35 Visitors Online


 
...Create and draw TShape at runtime?
Autor: Elias Marin
[ Print tip ]  

Tip Rating (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.

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners