was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

51 Visitors Online


 
...TShape zur Laufzeit erstellen und zeichnen?
Autor: Elias Marin
[ Tip ausdrucken ]  

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.

 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


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