Comment puis je créer une un shape at run time avec Drag-and-Drop ?

sarssor Messages postés 63 Date d'inscription dimanche 22 juillet 2007 Statut Membre Dernière intervention 28 avril 2011 - 21 mars 2011 à 13:06
sarssor Messages postés 63 Date d'inscription dimanche 22 juillet 2007 Statut Membre Dernière intervention 28 avril 2011 - 23 mars 2011 à 17:02
[b]Bonjour
Comment puis je créer une un shape at run time avec Drag-and-Drop ?

est-il possible?

merci/b

4 réponses

f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 37
22 mars 2011 à 00:25
all is possible, follow your imagination.

________________________________________________________
besoin de câbles audio, vidèo, informatique pas cher ?
0
sarssor Messages postés 63 Date d'inscription dimanche 22 juillet 2007 Statut Membre Dernière intervention 28 avril 2011
22 mars 2011 à 01:13
can you help me ?
0
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 37
23 mars 2011 à 00:17
for create a shape -> search on google "Delphi dynamic object creating at run-time"
for drag'n'drop -> search on google "Delphi object drag and drop"

Google is your friend, and the torry's delphi website too.

Good luck and good coding.
________________________________________________________
besoin de câbles audio, vidèo, informatique pas cher ?
0
sarssor Messages postés 63 Date d'inscription dimanche 22 juillet 2007 Statut Membre Dernière intervention 28 avril 2011
23 mars 2011 à 17:02
j ai trouve un code mais je doit trouver le rest
can you help me ?
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
procedure DrawImageBounds(X, Y: Integer);
procedure CreateImage;
procedure Reset;
procedure ListImages;
procedure DeleteImages;
procedure DeleteImageBounds;
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.CreateImage;
procedure Swap(var X1, X2: Integer);
var
Temp: Integer;
begin
Temp := X1;
X1 := X2;
X2 := Temp;
end;
var
Image: TImage;
begin
SetLength(ImageArray, Length(ImageArray) + 1);
Image := TImage.Create(nil);
Image.Name := 'Image' + IntToStr(Length(ImageArray));
Image.Parent := Form14;
if (BottomRight.Y < TopLeft.Y) then
Swap(BottomRight.Y, TopLeft.Y);
if (BottomRight.X < TopLeft.X) then
Swap(BottomRight.X, TopLeft.X);
Image.Left := TopLeft.X;
Image.Top := TopLeft.Y;
Image.Height := BottomRight.Y - TopLeft.Y;
Image.Width := BottomRight.X - TopLeft.X;
//Image.Stretch := True;
//Image.Proportional := True;
Image.Picture.LoadFromFile('test.bmp');
ImageArray[High(ImageArray)] := Image;
end;

procedure TForm1.DeleteImages;
var
i: Integer;
begin
for i := High(ImageArray) downto 0 do
begin
ImageArray[i].Free;
end;
SetLength(ImageArray, 0);
end;

procedure TForm1.ListImages;
var
i: Integer;
begin
ListBox1.Items.Clear;
for i := 0 to ControlCount - 1 do
begin
if (Controls[i] is TImage) then
begin
ListBox1.Items.Add(Format('%s (%d / %d)', [TImage(Controls[i]).Name, TImage(Controls[i]).Width, TImage(Controls[i]).Height]));
end;
end;
end;

procedure TForm1.Reset;
begin
IsMouseDown := False;
TopLeft.X := 0;
TopLeft.Y := 0;
BottomRight.X := 0;
BottomRight.Y := 0;
end;

procedure TForm1.DrawImageBounds(X, Y: Integer);
begin
if not Assigned(ImageBoundsRect) then
begin
ImageBoundsRect := TShape.Create(Form14);
ImageBoundsRect.Parent := Form14;
ImageBoundsRect.Shape := stRectangle;
ImageBoundsRect.Brush.Style := bsClear;
ImageBoundsRect.Pen.Width := 1;
ImageBoundsRect.Pen.Color := clBlack;
ImageBoundsRect.Pen.Style := psDash;
end;
ImageBoundsRect.Left := TopLeft.X;
ImageBoundsRect.Top := TopLeft.Y;
ImageBoundsRect.Width := X - TopLeft.X;
ImageBoundsRect.Height := Y - TopLeft.Y;
end;

procedure TForm1.DeleteImageBounds;
begin
FreeAndNil(ImageBoundsRect);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteImages;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IsMouseDown := True;
TopLeft.X := X;
TopLeft.Y := Y;
end;


procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if IsMouseDown then
begin
BottomRight.X := X;
BottomRight.Y := Y;
DrawImageBounds(X, Y);
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if IsMouseDown then
begin
DeleteImageBounds;
CreateImage;
Reset;
ListImages;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteImages;
ListImages;
end;

end.
0