Creating components at runtime - Delphi - delphi

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.

Related

Why the OnEndDrag event is not called?

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);

How do I pass an event as a function parameter?

I have a form that has a list of useful procedures that I have created, that I often use in every project. I am adding a procedure that makes it simple to add a click-able image over where would be the TAccessory of a TListBoxItem. The procedure intakes the ListBox currently, but I would also need it to intake which procedure to call for the OnClick Event for the image.. Here is my existing code:
function ListBoxAddClick(ListBox:TListBox{assuming I need to add another parameter here!! but what????}):TListBox;
var
i : Integer;
Box : TListBox;
BoxItem : TListBoxItem;
Click : TImage;
begin
i := 0;
Box := ListBox;
while i <> Box.Items.Count do begin
BoxItem := Box.ListItems[0];
BoxItem.Selectable := False;
Click := Timage.Create(nil);
Click.Parent := BoxItem;
Click.Height := BoxItem.Height;
Click.Width := 50;
Click.Align := TAlignLayout.alRight;
Click.TouchTargetExpansion.Left := -5;
Click.TouchTargetExpansion.Bottom := -5;
Click.TouchTargetExpansion.Right := -5;
Click.TouchTargetExpansion.Top := -5;
Click.OnClick := // this is where I need help
i := +1;
end;
Result := Box;
end;
The desired procedure would be defined in the form that is calling this function.
Since the OnClick event is of type TNotifyEvent you should define a parameter of that type. Look at this (I hope self-explaining) example:
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
procedure TheClickEvent(Sender: TObject);
end;
implementation
procedure ListBoxAddClick(ListBox: TListBox; OnClickMethod: TNotifyEvent);
var
Image: TImage;
begin
Image := TImage.Create(nil);
// here is assigned the passed event method to the OnClick event
Image.OnClick := OnClickMethod;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// here the TheClickEvent event method is passed
ListBoxAddClick(ListBox1, TheClickEvent);
end;
procedure TForm1.TheClickEvent(Sender: TObject);
begin
// do something here
end;

Highlight TPanel on mouse move

I'm trying to make app to show some information, It'll create Panels runtime and place info on it, each panel will be flat as on picture, also app will use runtime themes, so i'd not be able to change panel bg color on mouse move, I tried to place info on TSpeedButton :v O.o it has wonderfull highlight function when it's flat while app is using runtime theme, but the main problem is that images and labels aren't moving when i move speedbutton and i need this much, they just stay there..
I tried to edit TCustomPanel.Paint to see if panel will look like highlighted button, adding code at the end:
PaintRect := ClientRect;
Details := StyleServices.GetElementDetails(ttbButtonHot);
StyleServices.DrawElement(Canvas.Handle, Details, PaintRect);
but with no success..
also it's pretty hard to link some custom code OnClick event at runtime, e.g:
ShowMessage('custom message on each panel');
I have not got any idea on how to do this, hope some one will give me advice or show me some example..
btw, panel will be created this way:
var
P: TPanel;
begin
P := TPanel.Create(Self);
P.Left := 20;
P.Top := 100;
P.Width := 60;
P.Height := 20;
P.Visible := True;
P.Parent := Self;
#P.OnClick := #Showmessageproc; // somehow this way..
end;
App pic:
If i do so:
procedure TMyPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
mEvnt: TTrackMouseEvent;
begin
inherited;
if not FMouseTracking then begin
mEvnt.cbSize := SizeOf(mEvnt);
mEvnt.dwFlags := TME_LEAVE;
mEvnt.hwndTrack := Handle;
TrackMouseEvent(mEvnt);
FMouseTracking := True;
showmessage('IN');
end;
end;
procedure TMyPanel.WMMouseLeave(var Msg: TMessage);
begin
if Msg.Msg = WM_MOUSELEAVE then showmessage('OUT');
Msg.Result := 0;
FMouseTracking := False;
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
procedure G(Sender: TObject);
begin
showmessage('message');
end;
procedure TMainFrm.Button1Click(Sender: TObject);
var
P: TMyPanel;
begin
P := TMyPanel.Create(Self);
P.Left := 20;
I := I + 100;
P.Top := I;
P.Width := 200;
P.Height := 80;
P.Visible := True;
P.Parent := Self;
#P.OnClick := #g;
end;
when I move mouse on runtime created panel, 2 msgbox appears, IN and OUT, "mousemove" works fine but "mouse leave" bad, also the mainc question is still actual. the problem is that that I can't get canvas of created panel to draw on. the example above could be achieved more simple way:
#P.OnMouseLeave := #onmouseleaveproc;
#P.OnMouseMove := #onmousemoveproc;
but with Canvas, everything is more difficult, somewhere i've read that canvas is protected in TCustomPanel.
Also there's another question: Is it possible to handle panel wich called e.g OnMouseMove ? because there maybe will be 30 of them (runtime created panels)
I've tried this way: (and it does not works)
type
TMyPanel = class(TPanel)
public
constructor Create(AOwner: TComponent); override;
private
// FMouseTracking: Boolean;
// FOnMouseLeave: TNotifyEvent;
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
// procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
published
// property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
ControlStyle := ControlStyle - [csParentBackground] + [csOpaque];
inherited;
end;
procedure TMyPanel.CMMouseEnter(var msg: TMessage);
begin
inherited;
Color := clBlue;
{ Do Whatever }
end;
procedure TMyPanel.CMMouseLeave(var msg: TMessage);
begin
inherited;
Color := clRed;
{ Do Whatever }
end;
Simply, color does not changes. (color changes with themes OFF)
It's basically explained here for Delphi 6, but same concept I think. You want to define a custom windows message handler for your panel. This will give you basic mouse enter/exit capability. You can then play with setting TPanel properties from there to find something to your liking. For example, to mock a speed button, you might be able to just set the background color and change the border bevel accordingly. If that isn't adequate, you can write to the TPanel's Canvas directly (paint the behavior that you want to see) on mouse enter/exit to get the visual behavior you're after.
I created the following new component in Delphi and installed it. A new TColorPanel component showed up in a new MyComponents tab in the IDE. I then used this to put a TColorPanel on a new app and it responded properly to the mouse enter/leave events, changing the color as desired. I'm not sure how you made your app's panels as TMyPanel instead of standard TPanel. This is just how I tried it. I used your latest message handling code as-is.
unit ColorPanel;
interface
uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TColorPanel = class(TPanel)
public
constructor Create(AOwner: TComponent); override;
private
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
// procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
published
// property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyComponents', [TColorPanel]);
end;
constructor TColorPanel.Create(AOwner: TComponent);
begin
ControlStyle := ControlStyle - [csParentBackground] + [csOpaque];
inherited;
end;
procedure TColorPanel.CMMouseEnter(var msg: TMessage);
begin
inherited;
Color := clBlue;
{ Do Whatever }
end;
procedure TColorPanel.CMMouseLeave(var msg: TMessage);
begin
inherited;
Color := clRed;
{ Do Whatever }
end;
end.
I'm not sure why yours isn't working, other than to determine how you declared your app's panels to be TMyPanel.

Can Delphi dragging be "promoted" to docking?

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 to create an array of controls?

I have to create an array and place all controls there in order to access them.Here's a short example:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
const Test:Array[0..2] of TButton = (Button1,Button2,Button3);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
end.
Undeclarated idenitifier 'Button1' at the line where I declarated my array.But it's declarated three lines above.
Where's the problem,how to put all controls in an array?
EDIT:
Thank you for your answers,but I've got problems:
var TestA:TObjectList<TButton>;
var index:TComponent;
begin
TestA := TObjectList<TButton>.Create(false);
for index in Form7 do
if pos(index.name, 'Button') = 1 then
TestA.add(TButton(index));
TestA[0].Caption := 'Test'; //Exception out of range.
Ben's right. You can't set up a control array in the form designer. But if you have 110 images, for this specific case you can put them into a TImageList component and treat its collection of images as an array.
If you've got a bunch of more normal controls, like buttons, you'll have to create an array and load them into it in code. There are two ways to do this. The simple way, for small arrays at least, is Ben's answer. For large control sets, or ones that change frequently, (where your design is not finished, for example,) as long as you make sure to give them all serial names (Button1, Button2, Button3...), you can try something like this:
var
index: TComponent;
list: TObjectList;
begin
list := TObjectList.Create(false); //DO NOT take ownership
for index in frmMyForm do
if pos('Button', index.name) = 1 then
list.add(index);
//do more stuff once the list is built
end;
(Use a TObjectList<TComponent>, or something even more specific, if you're using D2009.) Build the list, based on the code above, then write a sorting function callback that will sort them based on name and use it to sort the list, and you've got your "array."
You may not be able to reference public properties of your form in an array constant like that. Try doing it in your form constructor/OnCreate event instead.
procedure TForm1.FormCreate(Sender: TObject);
begin
Test[0] := Button1;
Test[1] := Button2;
Test[2] := Button3;
end;
This function will iterate over all the controls on a specified container, like a particular TPanel or even the entire form, and populate a specified TObjectList with your TImage controls.
procedure TForm1.AddImageControlsToList(AParent: TWinControl; AList: TObjectList; Recursive: boolean);
var
Index: integer;
AChild: TControl;
begin
for Index := 0 to AParent.ControlCount - 1 do
begin
AChild := AParent.Controls[Index];
if AChild is TImage then // Or whatever test you want to use
AList.Add(AChild)
else if Recursive and (AChild is TWinControl) then
AddImageControlsToList(TWinControl(AChild), AList, True);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Call like this or similar to get your list of images
// (assumes MyImageList is declared in Form)
MyImageList := TObjectList.Create(False);
AddImageControlsToList(Self, MyImageList, True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// Destroy the list
FreeAndNil(MyImageList);
end;
How about this?
procedure TForm1.FormCreate(Sender: TObject);
begin
for b := 1 to 110 do
Test[b] := FindComponent('Button' + IntToStr(b)) as TButton;
end;
You'll have to declare the array as a variable rather than a constant and it will have to go from 1 to 110 rather than 0 to 109 but that's no problem.
I use this all the time - it is simple and fast (despite Mr Wheeler's comment)- declare the maxbuttons as a constant
var
Form1: TForm1;
pbutton:array[1..maxbuttons] of ^tbutton;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
(* Exit *)
var k:integer;
begin
for k:=1 to maxbuttons do dispose(pbutton[k]);
close;
end;
procedure TForm1.FormActivate(Sender: TObject);
var k:integer;
begin
(*note the buttons must be Button1, Button2 etc in sequence or you need to
allocate them manually eg pbutton[1]^:=exitbtn etc *)
for k:=1 to maxbuttons do
begin
new(pbutton[k]);
pbutton[k]^:= tbutton(FindComponent('Button'+IntToStr(k)));
end;
end;
procedure TForm1.ButtonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var k:integer;
b:boolean;
begin
b:=false;
k:=1;
while (k<= maxbuttons) and (not b) do
begin
if pbutton[k]^ = sender then (Note sender indicates which button has been clicked)
begin
{ found it so do something}
b:=true;
end;
k:=k+1;
end;
end;
Try this
var
TestA:TObjectList;
index:TComponent;
begin
TestA := TObjectList<TButton>.Create(false);
try
for index in Form7 do
if (pos is TButton) OR {or/and} (pos.tag and 8=8) then
TestA.add(TButton(index));
if TestA.Count>0 then //Fix:Exception out of range.
TestA[0].Caption := 'Test';
finally
TestA.Free;
end;
end;

Resources