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

Question

[b]Bonjour
Comment puis je créer une un shape at run time avec Drag-and-Drop ?

est-il possible?

merci/b

f0xi · Answer

all is possible, follow your imagination.

________________________________________________________
besoin de câbles audio, vidèo, informatique pas cher ?

sarssor · Answer

can you help me ?

f0xi · Answer

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 ?

sarssor · Answer

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.

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

4 réponses

Votre réponse

Discussions similaires