I'm trying to detect the end of a drag & drop operation by using the TControl.OnEndDrag event.
It seems that the OnEndDrag event is never called when the DragObject parameter is assigned from the OnStartDrag event.
TMyForm = class(TForm)
procedure FormCreate(Sender: TObject);
public
MyLabel : TLabel;
procedure MyOnEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure MyOnStartDrag(Sender: TObject; var DragObject: TDragObject);
end;
procedure TMyForm.FormCreate(Sender: TObject);
begin
MyLabel := TLabel.Create(Self);
MyLabel.Caption := 'Drag me';
MyLabel.Left := 50;
MyLabel.Top := 50;
MyLabel.OnStartDrag := MyOnStartDrag;
MyLabel.OnEndDrag := MyOnEndDrag;
MyLabel.DragMode := dmAutomatic;
MyLabel.Parent := Self;
end;
procedure TMyForm.MyOnEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
ShowMessage('MyOnEndDrag');
end;
procedure TMyForm.MyOnStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
DragObject := TDragObjectEx.Create;
end;
I think the problem could be related to the DragObject's class but I don't understand what I'm doing wrong. How can I make sure the OnEndDrag event is called?
A drag object needs to know which control it should notify when the drag ends. The specialized class for this kind of operation in the VCL, that is a drag object that can be associated with a single control, is a TBaseDragControlObject. TDragControlObject[Ex] is the appropriate descendant which deals with dropping as opposed to its sibling TDragDockObject which deals with docking.
DragObject := TDragControlObjectEx.Create(MyLabel);
Related
I got a memory leak error after drag & drop.
TMyDragObject = class(TDragObject)
public
MyInfo : string;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
System.ReportMemoryLeaksOnShutdown := True;
Button1.DragMode := dmAutomatic;
end;
procedure TForm1.Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
DragObject := TMyDragObject.Create;
TMyDragObject(DragObject).MyInfo := 'hi!';
end;
Where should DragObject be freed?
Thanks to all.
Free the object in the OnDragDrop handler for the control accepting the drop. Here's the event for a TMemo:
procedure TForm4.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if IsDragObject(Source) then
begin
Memo1.Lines.Add(TMyDragObject(Source).MyInfo);
Source.Free;
end;
end;
Here's a more complete (and very trivial) example. Drop a TButton and TMemo on the form, set Button1.DragMode to dmAutomatic, add the variable Ctr: Integer to the form's private section, and wire up the event handlers; it allows you to drag the button into the memo, adding the text Item + the current value of Ctr to the memo's lines.
type
TMyDragObject=class(TDragObject)
Info: string;
end;
procedure TForm4.Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
Inc(Ctr);
DragObject := TMyDragObject.Create;
TMyDragObject(DragObject).Info := 'Item ' + IntToStr(Ctr);
end;
procedure TForm4.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if IsDragObject(Source) then
begin
Memo1.Lines.Add(TMyDragObject(Source).Info);
Source.Free;
end;
end;
procedure TForm4.Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := IsDragObject(Source);
end;
As an alternative, inherit from TDragObjectEx, which is automatically freed at the end of the drop operation, according to the documentation.
Note: TDragObject is not automatically freed at the end of a drag
operation. To work with a drag object that is freed at the end of the
drag operation, use TDragObjectEx instead
I am writing a WYSIWYG type of editor program in which the user can drag image thumbnails onto an editor surface (TPanel) and then create a PDF by rendering the editor surface onto the PDF.
On my TPanel, I have a TImage which the user can resize and move. I am using TSizeCtrl for this.
I have a TJvThumbview which is being loaded with images from a disk folder.
I want to accomplish drag-drop from the JvThumbview onto the TImage - but cannot do this.
Please can someone detail how I would accomplish this?
Thanks so much in advance.
I cannot resist.
My demo project consists of:
one TJvThumbView and
one TImage
Dragging is achieved by:
starting the drag operation when the user mouse-downs on the thumb view,
managing the dragged image by a TDragObject derivative,
drawing the dragged image when the drag object says the drag operation ended on the TImage.
This is how it could look like:
unit Unit1;
interface
uses
Classes, Graphics, Controls, Forms, JvExForms, JvBaseThumbnail, JvThumbViews,
ExtCtrls;
type
TMyDragObject = class(TDragControlObjectEx)
private
FDragImages: TDragImageList;
FPictureToDrag: TPicture;
protected
function GetDragImages: TDragImageList; override;
procedure Finished(Target: TObject; X, Y: Integer;
Accepted: Boolean); override;
public
constructor CreateFromThumbView(ThumbView: TJvThumbView);
destructor Destroy; override;
end;
TForm1 = class(TForm)
JvThumbView1: TJvThumbView;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure JvThumbView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure JvThumbView1StartDrag(Sender: TObject;
var DragObject: TDragObject);
procedure Image1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Fill our image list with arbitrary images
if JvThumbView1.Directory = '' then
JvThumbView1.Directory := 'C:\Users\Public\Pictures\Sample Pictures';
// Style all controls for showing the drag image if Delphi version is D7 or
// lower. See also comment in TMyDragObject.CreateFromThumbView
JvThumbView1.ControlStyle := JvThumbView1.ControlStyle +
[csDisplayDragImage];
Image1.ControlStyle := Image1.ControlStyle + [csDisplayDragImage];
ControlStyle := ControlStyle + [csDisplayDragImage];
end;
procedure TForm1.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
// The destination image component accepts all drag operations
Accept := True;
end;
procedure TForm1.JvThumbView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// If mouse down on a thumb...
if JvThumbView1.SelectedFile <> '' then
// then let's start dragging
JvThumbView1.BeginDrag(False, Mouse.DragThreshold);
end;
procedure TForm1.JvThumbView1StartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
// DragObject will automatically be destroyed when necessary when it's
// derived from TDragControlObjectEx
DragObject := TMyDragObject.CreateFromThumbView(JvThumbView1);
end;
{ TMyDragObject }
const
DragImageSize = 100;
constructor TMyDragObject.CreateFromThumbView(ThumbView: TJvThumbView);
begin
inherited Create(ThumbView);
// This is the picture the user will drag around
FPictureToDrag := TPicture.Create;
FPictureToDrag.LoadFromFile(ThumbView.SelectedFile);
// We want a nice drag image, but this property is only available in >D7
{ AlwaysShowDragImages := True; }
end;
destructor TMyDragObject.Destroy;
begin
FDragImages.Free;
FPictureToDrag.Free;
inherited Destroy;
end;
procedure TMyDragObject.Finished(Target: TObject; X, Y: Integer;
Accepted: Boolean);
begin
// Finished dragging
inherited Finished(Target, X, Y, Accepted);
// If we are over an Image component, then draw the picture
if Accepted and (Target is TImage) then
TImage(Target).Canvas.StretchDraw(Bounds(X, Y, DragImageSize,
DragImageSize), FPictureToDrag.Graphic);
end;
function TMyDragObject.GetDragImages: TDragImageList;
var
DragImage: TBitmap;
begin
if FDragImages = nil then
begin
FDragImages := TDragImageList.Create(nil);
// Set dimensions of drag image list
FDragImages.Width := DragImageSize;
FDragImages.Height := DragImageSize;
// Prepare drag image
DragImage:= TBitmap.Create;
try
DragImage.Width := DragImageSize;
DragImage.Height := DragImageSize;
DragImage.Canvas.StretchDraw(Rect(0, 0, DragImage.Width,
DragImage.Height), FPictureToDrag.Graphic);
FDragImages.AddMasked(DragImage, clWhite);
finally
DragImage.Free;
end;
end;
Result := FDragImages;
end;
end.
I have a TTreeView that can have lots of nodes, when a lot of nodes are expanded the tree uses a lot of screen space.
Now suppose I want to drag a node that is near the bottom of the TreeView to the top, I can't physically see the top part of the TreeView because the node I am selecting is at the bottom. When dragging the node to the top of the TreeView I would like the TreeView to automatically scroll with me when dragging, by default this does not seem to happen.
A perfect example of this behaviour is seen in Windows Explorer. If you try to drag a file or folder, when you hover the dragged item (node) it automatically scrolls up or down depending on cursor position.
Hope that makes sense.
PS, I already know how to drag nodes, I want the TreeView to scroll with me when dragging if hovering near the top or bottom of the TreeView.
Thanks.
This is the code I use. It will work for any TWinControl descendent: list box, tree view, list view etc.
type
TAutoScrollTimer = class(TTimer)
private
FControl: TWinControl;
FScrollCount: Integer;
procedure InitialiseTimer;
procedure Timer(Sender: TObject);
public
constructor Create(Control: TWinControl);
end;
{ TAutoScrollTimer }
constructor TAutoScrollTimer.Create(Control: TWinControl);
begin
inherited Create(Control);
FControl := Control;
InitialiseTimer;
end;
procedure TAutoScrollTimer.InitialiseTimer;
begin
FScrollCount := 0;
Interval := 250;
Enabled := True;
OnTimer := Timer;
end;
procedure TAutoScrollTimer.Timer(Sender: TObject);
procedure DoScroll;
var
WindowEdgeTolerance: Integer;
Pos: TPoint;
begin
WindowEdgeTolerance := Min(25, FControl.Height div 4);
GetCursorPos(Pos);
Pos := FControl.ScreenToClient(Pos);
if not InRange(Pos.X, 0, FControl.Width) then begin
exit;
end;
if Pos.Y<WindowEdgeTolerance then begin
SendMessage(FControl.Handle, WM_VSCROLL, SB_LINEUP, 0);
end else if Pos.Y>FControl.Height-WindowEdgeTolerance then begin
SendMessage(FControl.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
end else begin
InitialiseTimer;
exit;
end;
if FScrollCount<50 then begin
inc(FScrollCount);
if FScrollCount mod 5=0 then begin
//speed up the scrolling by reducing the timer interval
Interval := MulDiv(Interval, 3, 4);
end;
end;
if Win32MajorVersion<6 then begin
//in XP we need to clear up transient "fluff"; results in flickering so only do it in XP where it is needed
FControl.Invalidate;
end;
end;
begin
if Mouse.IsDragging then begin
DoScroll;
end else begin
Free;
end;
end;
Then to use it you add an OnStartDrag event handler for the control and implement it like this:
procedure TMyForm.SomeControlStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
TAutoScrollTimer.Create(Sender as TWinControl);
end;
Here's an alternative based on the fact that the selected node always automatically scrolls in view.
type
TForm1 = class(TForm)
TreeView1: TTreeView;
TreeView2: TTreeView;
procedure TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure TreeViewEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure TreeViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FDragNode: TTreeNode;
FNodeHeight: Integer;
end;
...
procedure TForm1.TreeViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
with TTreeView(Sender) do
begin
FDragNode := GetNodeAt(X, Y);
if FDragNode <> nil then
begin
Selected := FDragNode;
with FDragNode.DisplayRect(False) do
FNodeHeight := Bottom - Top;
BeginDrag(False, Mouse.DragThreshold);
end;
end;
end;
procedure TForm1.TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
Pt: TPoint;
DropNode: TTreeNode;
begin
Accept := Source is TTreeView;
if Accept then
with TTreeView(Source) do
begin
if Sender <> Source then
Pt := ScreenToClient(Mouse.CursorPos)
else
Pt := Point(X, Y);
if Pt.Y < FNodeHeight then
DropNode := Selected.GetPrevVisible
else if Pt.Y > (ClientHeight - FNodeHeight) then
DropNode := Selected.GetNextVisible
else
DropNode := GetNodeAt(Pt.X, Pt.Y);
if DropNode <> nil then
Selected := DropNode;
end;
end;
procedure TForm1.TreeViewEndDrag(Sender, Target: TObject; X, Y: Integer);
var
DropNode: TTreeNode;
begin
with TTreeView(Sender) do
if Target <> nil then
begin
DropNode := Selected;
DropNode := Items.Insert(DropNode, '');
DropNode.Assign(FDragNode);
Selected := DropNode;
Items.Delete(FDragNode);
end
else
Selected := FDragNode;
end;
You may want to link the OnDragOver event handler to the parent of the TreeView too, which results in scrolling ánd dropping when the mouse is outside the TreeView. If you dó want the scrolling, but not the dropping when the mouse is outside the TreeView, then check if Target = Sender in the OnEndDrag event handler.
Just to be complete, workarounds like in the other answers are not required anymore. Later versions have an option for this:
TreeOptions.AutoOptions.toAutoScroll := True
I have a TPageControl whose pages are all various forms that are attached using ManualDock(). The user should be able to rearrange the tabs by dragging them, which works already. It should however also be possible to undock the docked forms.
For now I have the following code:
procedure TMainForm.PageControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) and (Shift * [ssShift, ssCtrl] = [])
and PageControl.DockSite
then begin
PageControl.BeginDrag(False, 32);
end;
end;
If either the Shift or the Ctrl key are held down, then a docking operation will be started, otherwise the tabs can be rearranged by dragging them.
Using the keys as modifiers is awkward though. Is there any way to cancel the active drag operation when the mouse cursor is outside of the tab area of the page control, and start docking the child form? This is with Delphi 2009.
I have a solution now which works for me, so I'll answer myself - maybe somebody has a use for this too.
Let's start with a small sample application that creates a TPageControl with 8 docked forms, with code to allow for runtime reordering of the tabs. Tabs will be moved live, and when the dragging is canceled the active tab index will revert to its original value:
unit uDragDockTest;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
ComCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
fPageControl: TPageControl;
fPageControlOriginalPageIndex: integer;
function GetPageControlTabIndex(APosition: TPoint): integer;
public
procedure PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure PageControlDragOver(Sender, Source: TObject; X, Y: Integer;
AState: TDragState; var AAccept: Boolean);
procedure PageControlEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure PageControlMouseDown(Sender: TObject; AButton: TMouseButton;
AShift: TShiftState; X, Y: Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
const
FormColors: array[1..8] of TColor = (
clRed, clGreen, clBlue, clYellow, clLime, clMaroon, clTeal, clAqua);
var
i: integer;
F: TForm;
begin
fPageControlOriginalPageIndex := -1;
fPageControl := TPageControl.Create(Self);
fPageControl.Align := alClient;
// set to False to enable tab reordering but disable form docking
fPageControl.DockSite := True;
fPageControl.Parent := Self;
fPageControl.OnDragDrop := PageControlDragDrop;
fPageControl.OnDragOver := PageControlDragOver;
fPageControl.OnEndDrag := PageControlEndDrag;
fPageControl.OnMouseDown := PageControlMouseDown;
for i := Low(FormColors) to High(FormColors) do begin
F := TForm.Create(Self);
F.Caption := Format('Form %d', [i]);
F.Color := FormColors[i];
F.DragKind := dkDock;
F.BorderStyle := bsSizeToolWin;
F.FormStyle := fsStayOnTop;
F.ManualDock(fPageControl);
F.Show;
end;
end;
const
TCM_GETITEMRECT = $130A;
function TForm1.GetPageControlTabIndex(APosition: TPoint): integer;
var
i: Integer;
TabRect: TRect;
begin
for i := 0 to fPageControl.PageCount - 1 do begin
fPageControl.Perform(TCM_GETITEMRECT, i, LPARAM(#TabRect));
if PtInRect(TabRect, APosition) then
Exit(i);
end;
Result := -1;
end;
procedure TForm1.PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
var
Index: integer;
begin
if Sender = fPageControl then begin
Index := GetPageControlTabIndex(Point(X, Y));
if (Index <> -1) and (Index <> fPageControl.ActivePage.PageIndex) then
fPageControl.ActivePage.PageIndex := Index;
end;
end;
procedure TForm1.PageControlDragOver(Sender, Source: TObject; X, Y: Integer;
AState: TDragState; var AAccept: Boolean);
var
Index: integer;
begin
AAccept := Sender = fPageControl;
if AAccept then begin
Index := GetPageControlTabIndex(Point(X, Y));
if (Index <> -1) and (Index <> fPageControl.ActivePage.PageIndex) then
fPageControl.ActivePage.PageIndex := Index;
end;
end;
procedure TForm1.PageControlEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
// restore original index of active page if dragging was canceled
if (Target <> fPageControl) and (fPageControlOriginalPageIndex > -1)
and (fPageControlOriginalPageIndex < fPageControl.PageCount)
then
fPageControl.ActivePage.PageIndex := fPageControlOriginalPageIndex;
fPageControlOriginalPageIndex := -1;
end;
procedure TForm1.PageControlMouseDown(Sender: TObject; AButton: TMouseButton;
AShift: TShiftState; X, Y: Integer);
begin
if (AButton = mbLeft)
// undock single docked form or reorder multiple tabs
and (fPageControl.DockSite or (fPageControl.PageCount > 1))
then begin
// save current active page index for restoring when dragging is canceled
fPageControlOriginalPageIndex := fPageControl.ActivePageIndex;
fPageControl.BeginDrag(False);
end;
end;
end.
Paste this into the editor and run it, all necessary components and their properties will be created and set up at runtime.
Note that undocking the forms is possible only by double-clicking the tabs. It's also somewhat ugly that the drag cursor will be shown until the left mouse button is released, regardless of the distance from the tabs. It would be much better if the dragging was automatically canceled and the form be undocked instead, when the mouse is outside of the page control tab area with a few pixels margin.
This can be achieved by creating a custom DragObject in the OnStartDrag handler of the page control. In this object the mouse is captured, so all mouse messages while dragging can be handled in it. When the mouse cursor is outside of the tab influence rectangle the dragging is canceled, and a docking operation for the form in the active page control sheet is started instead:
type
TConvertDragToDockHelper = class(TDragControlObjectEx)
strict private
fPageControl: TPageControl;
fPageControlTabArea: TRect;
protected
procedure WndProc(var AMsg: TMessage); override;
public
constructor Create(AControl: TControl); override;
end;
constructor TConvertDragToDockHelper.Create(AControl: TControl);
const
MarginX = 32;
MarginY = 12;
var
Item0Rect, ItemLastRect: TRect;
begin
inherited;
fPageControl := AControl as TPageControl;
if fPageControl.PageCount > 0 then begin
// get rects of first and last tab
fPageControl.Perform(TCM_GETITEMRECT, 0, LPARAM(#Item0Rect));
fPageControl.Perform(TCM_GETITEMRECT, fPageControl.PageCount - 1,
LPARAM(#ItemLastRect));
// calculate rect valid for dragging (includes some margin around tabs)
// when this area is left dragging will be canceled and docking will start
fPageControlTabArea := Rect(
Min(Item0Rect.Left, ItemLastRect.Left) - MarginX,
Min(Item0Rect.Top, ItemLastRect.Top) - MarginY,
Max(Item0Rect.Right, ItemLastRect.Right) + MarginX,
Max(Item0Rect.Bottom, ItemLastRect.Bottom) + MarginY);
end;
end;
procedure TConvertDragToDockHelper.WndProc(var AMsg: TMessage);
var
MousePos: TPoint;
CanUndock: boolean;
begin
inherited;
if AMsg.Msg = WM_MOUSEMOVE then begin
MousePos := fPageControl.ScreenToClient(Mouse.CursorPos);
// cancel dragging if outside of tab area with margins
// optionally start undocking the docked form (can be canceled with [ESC])
if not PtInRect(fPageControlTabArea, MousePos) then begin
fPageControl.EndDrag(False);
CanUndock := fPageControl.DockSite and (fPageControl.ActivePage <> nil)
and (fPageControl.ActivePage.ControlCount > 0)
and (fPageControl.ActivePage.Controls[0] is TForm)
and (TForm(fPageControl.ActivePage.Controls[0]).DragKind = dkDock);
if CanUndock then
fPageControl.ActivePage.Controls[0].BeginDrag(False);
end;
end;
end;
The class descends from TDragControlObjectEx instead of from TDragControlObject so that it will be automatically freed. Now if a handler for the TPageControl in the sample application is created (and set for the page control object):
procedure TForm1.PageControlStartDrag(Sender: TObject;
var ADragObject: TDragObject);
begin
// do not cancel dragging unless page control has docking enabled
if (ADragObject = nil) and fPageControl.DockSite then
ADragObject := TConvertDragToDockHelper.Create(fPageControl);
end;
then the tab dragging will be canceled when the mouse moves far enough away from the tabs, and if the active page is a dockable form then a docking operation for it will be started, which can still be canceled with the ESC key.
How can I create a component at runtime and then work with it (changing properties, etc.)?
It depends if it is a visual or non-visual component. The principle is the same, but there are some additional considerations for each kind of component.
For non-visual components
var
C: TMyComponent;
begin
C := TMyComponent.Create(nil);
try
C.MyProperty := MyValue;
//...
finally
C.Free;
end;
end;
For visual components:
In essence visual components are created in the the same way as non-visual components. But you have to set some additional properties to make them visible.
var
C: TMyVisualComponent;
begin
C := TMyVisualComponent.Create(Self);
C.Left := 100;
C.Top := 100;
C.Width := 400;
C.Height := 300;
C.Visible := True;
C.Parent := Self; //Any container: form, panel, ...
C.MyProperty := MyValue,
//...
end;
A few explanations to the code above:
By setting the owner of the component (the parameter of the constructor) the component gets destroyed when the owning form gets destroyed.
Setting the Parent property makes the component visible. If you forget it your component will not be displayed. (It's easy to miss that one :) )
If you want many components you can do the same as above but in a loop:
var
B: TButton;
i: Integer;
begin
for i := 0 to 9 do
begin
B := TButton.Create(Self);
B.Caption := Format('Button %d', [i]);
B.Parent := Self;
B.Height := 23;
B.Width := 100;
B.Left := 10;
B.Top := 10 + i * 25;
end;
end;
This will add 10 buttons at the left border of the form. If you want to modify the buttons later, you can store them in a list. (TComponentList ist best suited, but also take a look at the proposals from the comments to this answer)
How to assign event handlers:
You have to create an event handler method and assign it to the event property.
procedure TForm1.MyButtonClick(Sender: TObject);
var
Button: TButton;
begin
Button := Sender as TButton;
ShowMessage(Button.Caption + ' clicked');
end;
B := TButton.Create;
//...
B.OnClick := MyButtonClick;
To simplify the runtime component creation process, you can use GExperts.
Create a component (or more components) visually and set its properties.
Select one or more components and execute GExperts, Components to Code.
Paste the generated code into your application.
Remove component(s) from the visual form designer.
Example (TButton-creation code generated in this way):
var
btnTest: TButton;
btnTest := TButton.Create(Self);
with btnTest do
begin
Name := 'btnTest';
Parent := Self;
Left := 272;
Top := 120;
Width := 161;
Height := 41;
Caption := 'Component creation test';
Default := True;
ParentFont := False;
TabOrder := 0;
end;
I would just like to add that when dynamically adding controls...
it as a good idea to add them to an object list (TObjectList) as suggested in <1> by #Despatcher.
procedure Tform1.AnyButtonClick(Sender: TObject);
begin
If Sender is TButton then
begin
Case Tbutton(Sender).Tag of
.
.
.
// Or You can use the index in the list or some other property
// you have to decide what to do
// Or similar :)
end;
end;
procedure TForm1.BtnAddComponent(Sender: TObJect)
var
AButton: TButton;
begin
AButton := TButton.Create(self);
Abutton. Parent := [Self], [Panel1] [AnOther Visual Control];
AButton.OnClick := AnyButtonClick;
// Set Height and width and caption ect.
.
.
.
AButton.Tag := MyList.Add(AButton);
end;
You need to add the Unit 'Contnrs' to your Uses list.
I.e System.Contnrs.pas the base Containers Unit
And you can have many object lists.
I suggest using a TObjectList for each type of control that you use
e.g.
Interface
Uses Contnrs;
Type
TMyForm = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
Var
MyForm: TMyForm;
checkBoxCntrlsList: TObjectList; //a list for the checkBoxes I will createin a TPanel
comboboxCntrlsList: TObjectList; //a list of comboBoxes that I will create in some Form Container
this allows you to easily manipulate/manage each control as you will know what type of control it is e.g.
Var comboBox: TComboBox;
I: Integer;
begin
For I = 0 to comboboxCntrlsList.Count -1 do // or however you like to identify the control you are accessing such as using the tag property as #Despatcher said
Begin
comboBox := comboboxCntrlsList.Items[I] as TComboBox;
...... your code here
End;
end;
This allows you to then use the methods and properties of that control
Don't forget to create the TObjectLists, perhaps in the form create event...
checkBoxCntrlsList := TObjectList.Create;
comboboxCntrlsList := TObjectList.Create;
But if I don't surely know how many components I want to create, e.g. if it depends on user's decision. So how can I declare components dynamically?
The answer has been suggested - the easiest way is a List of Objects(components). TObjectList is the simplest to use (in unit contnrs). Lists are great!
In Form1 Public
MyList: TObjectList;
procedure AnyButtonClick(Sender: TObject);
// You can get more sophisticated and declare //TNotifyevents and assign them but lets keep it simple :)
.
.
.
procedure Tform1.AnyButtonClick(Sender: TObject);
begin
If Sender is TButton then
begin
Case Tbutton(Sender).Tag of
.
.
.
// Or You can use the index in the list or some other property
// you have to decide what to do
// Or similar :)
end;
end;
procedure TForm1.BtnAddComponent(Sender: TObJect)
var
AButton: TButton;
begin
AButton := TButton.Create(self);
Abutton. Parent := [Self], [Panel1] [AnOther Visual Control];
AButton.OnClick := AnyButtonClick;
// Set Height and width and caption ect.
.
.
.
AButton.Tag := MyList.Add(AButton);
end;
An Object list can contain any object visual or not but that gives you an added overhead of sorting out which items are which - better to have related lists if you want multiple dynamic controls on similar panels for instance.
Note: like other commenters I may have over-simplified for brevity but I hope you ge the idea. You need a mechanism to manage the objects once they are created and lists are excellent for this stuff.
Some components override the 'Loaded' method. This method will not be called automatically if you create an instance at runtime. It will be called by Delphi when loading from the form file (DFM) is complete.
If the method contains initialization code, your application might show unexpected behaviour when created at runtime. In this case, check if the component writer has used this method.
If you nest win controls in Group Boxes/Page Controls/Etc..., I think it is beneficial to have the parent group box also be the owner. I've noticed a sharp decrease in window close times when doing this, as opposed to having the owner always be the main form.
During a research on "creating a delphi form using xml based template", I find something useful pointing out RTTI and using open tools api (ToolsApi.pas I think). Have a look at the interfaces in the unit.
Very ease. Call Create. Example:
procedure test
var
b : TButton;
begin
b:=TButton.Create(nil);
b.visible:=false;
end;
This creates a component (TButton is a component) at runtime and sets the property visible.
For the constructor: pass nil if you want to manage the memory yourself. Pass a pointer another component if you want to have it destroyed when the other component is destroyed.
This is example how to emulate button tag on Evernote
unit Unit7;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, CHButton, Vcl.ExtCtrls, RzPanel, CHPanel, RzCommon,RzBmpBtn, Vcl.StdCtrls;
type
// This is panel Button
TButtonClose = class (TRzPanel)
CloseButton : TRzBmpButton;
procedure CloseButtonClick(Sender: TObject);
procedure CloseButtonMouseEnter(Sender: TObject);
procedure MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TForm7 = class(TForm)
CHButton1: TCHButton;
RzPanel1: TRzPanel;
RzBmpButton1: TRzBmpButton;
procedure CHButton1Click(Sender: TObject);
procedure RzBmpButton1Click(Sender: TObject);
procedure RzPanel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure RzPanel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure RzPanel1MouseEnter(Sender: TObject);
procedure RzBmpButton1MouseEnter(Sender: TObject);
procedure FormMouseEnter(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form7: TForm7;
MyCloseButton : TButtonClose;
implementation
{$R *.dfm}
// constructor for on the fly component created
constructor TButtonClose.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// Set Events for the component
Self.OnMouseEnter := Self.CloseButtonMouseEnter;
Self.OnMouseDown := Self.MouseDown;
Self.OnMouseUp := Self.MouseUp;
Self.Height := 25;
// Close button on top panel Button
// Inherited from Raize Bitmap Button
CloseButton := TRzBmpButton.Create(self);
// Set On Click Event for Close Button
CloseButton.OnClick := Self.CloseButtonClick;
// Place Close Button on Panel Button
CloseButton.Parent := self;
CloseButton.Left := 10;
CloseButton.Top := 5;
CloseButton.Visible := False;
// Setting the image for the button
CloseButton.Bitmaps.Up.LoadFromFile(ExtractFilePath(Application.ExeName)+'\close.bmp');
end;
procedure TButtonClose.CloseButtonClick(Sender: TObject);
begin
// Free the parent (Panel Button)
TControl(Sender).Parent.Free;
end;
procedure TButtonClose.CloseButtonMouseEnter(Sender: TObject);
begin
// Show the Close button
CloseButton.Visible := True;
end;
procedure TButtonClose.MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Emulate Button down state, since it is panel
TRzPanel(Sender).BorderOuter := fsLowered;
end;
procedure TButtonClose.MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Emulate Button up state, since it is panel
TRzPanel(Sender).BorderOuter := fsRaised;
end;
destructor TButtonClose.Destroy;
begin
inherited Destroy;
end;
procedure TForm7.FormCreate(Sender: TObject);
begin
// Create Panel Button on the fly
MyCloseButton := TButtonClose.Create(self);
MyCloseButton.Caption := 'My Button';
MyCloseButton.Left := 10;
MyCloseButton.Top := 10;
// Don't forget to place component on the form
MyCloseButton.Parent := self;
end;
procedure TForm7.FormMouseEnter(Sender: TObject);
begin
if Assigned(RzBmpButton1) then
RzBmpButton1.Visible := False;
// Hide when mouse leave the button
// Check first if myCloseButton Assigned or not before set visible property
if Assigned(MyCloseButton.CloseButton) then
MyCloseButton.CloseButton.Visible := False;
end;
procedure TForm7.RzBmpButton1Click(Sender: TObject);
begin
TControl(Sender).Parent.Free;
end;
procedure TForm7.RzBmpButton1MouseEnter(Sender: TObject);
begin
RzBmpButton1.Visible := True;
end;
procedure TForm7.RzPanel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
TRzPanel(Sender).BorderOuter := fsLowered;
end;
procedure TForm7.RzPanel1MouseEnter(Sender: TObject);
begin
RzBmpButton1.Visible := True;
end;
procedure TForm7.RzPanel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
TRzPanel(Sender).BorderOuter := fsRaised;
end;
procedure TForm7.CHButton1Click(Sender: TObject);
begin
FreeAndNil(Sender);
end;
end.