How do I pass an event as a function parameter? - delphi

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;

Related

FireMonkey: How do I change styleBook's style on all forms runtime?

I have 2 StyleBooks loaded with custom styles and want them to be applied for all forms at once (testing it on windows, Tokyo 10.2.3).
procedure TForm6.Button1Click(Sender: TObject);
begin
StyleBook := StyleBook2;
end;
procedure TForm6.Button2Click(Sender: TObject);
begin
StyleBook := StyleBook1;
end;
If I set UseStyleManager=true, this code doesn't work. If UseStyleManager=false, it works but only for 1 form.
You can use Application.Components[] to get access to each form and set its StyleBook property. Leave UseStyleManager = False for both stylebooks.
Add to the main form:
type
TForm14 = class(TForm)
...
private
procedure ChangeApplicationStyle(sb: TStyleBook);
and implement:
procedure TForm14.ChangeApplicationStyle(sb: TStyleBook);
var
i: integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is TForm then
TForm(Application.Components[i]).StyleBook := sb;
end;
Finally to change, e.g.:
procedure TForm14.Button1Click(Sender: TObject);
begin
ChangeApplicationStyle(StyleBook1);
end;
procedure TForm14.Button2Click(Sender: TObject);
begin
ChangeApplicationStyle(StyleBook2);
end;

Communicating between frames in Delphi

I just started using Frames in Delphi.
That Frames are in FrameBar1 and they both are visible. Just for testing, first one contains one Button and second Frame contains one Edit.
I want to change text in Edit with click on Button (which are controls on two different frames).
How to communicate between frames?
The same way you would if the controls were in the same Form. Just prefix the Edit control with the Frame object that owns it, eg:
uses
Frame1Unit, Frame2Unit;
procedure TForm1.FormCreate(Sender: TObject);
begin
Frame1 := TFrame1.Create(Self);
Frame1.Parent := ...;
...
Frame2 := TFrame2.Create(Self);
Frame2.Parent := ...;
...
end;
uses
Frame2Unit;
procedure TFrame1.Button1Click(Sender: TObject);
begin
Frame2.Edit1.Text := '...';
end;
A better design would be to encapsulate the logic so Frame1 and Frame2 do not know about each other. Have Frame1 expose an event that it fires when the button is clicked, and then the parent Form can assign a handler to that event and assign the text on the Frame2, eg:
uses
Frame1Unit, Frame2Unit;
procedure TForm1.FormCreate(Sender: TObject);
begin
Frame1 := TFrame1.Create(Self);
Frame1.Parent := ...;
Frame1.OnNewText := Frame1Text;
...
Frame2 := TFrame2.Create(Self);
Frame2.Parent := ...;
...
end;
procedure TForm1.Frame1Text(Sender: TObject; const NewText: string);
begin
Frame2.EditText := NewText;
end;
type
TFrame1TextEvent = procedure(Sender: TObject; const NewText; string) of object;
TFrame1 = class(TFrame)
Button1: TButton;
procedure Button1Click(Sender: TObject);
public
OnNewText: TFrame1TextEvent;
end;
procedure TFrame1.Button1Click(Sender: TObject);
begin
if Assigned(OnNewText) then
OnNewText(Self, '...');
end;
type
TFrame2 = class(TFrame)
Edit1: TEdit;
private
function GetEditText: string;
procedure SetEditText(const Value: string);
public
property EditText: string read GetEditText write SetEditText;
end;
function TFrame2.GetEditText: string;
begin
Result := Edit1.Text;
end;
procedure TFrame2.SetEditText(const Value: string);
begin
Edit1.Text := Value;
end;

Popup Menu not appearing at my Delphi

There are TPopupMenu and three buttons on the form named "AddButton", "EditButton", and "DestroyButton" and added OnClick events to all three buttons. The TPopupMenu in the PopupMenu property of the form. I have created the PopupMenuItemsClick procedure in the TForm1 type declaration so that it can be used as the method call for the menu item OnClick event.
type
TForm1 = class(TForm)
AddButton: TButton;
EditButton: TButton;
DestroyButton: TButton;
PopupMenu1: TPopupMenu;
procedure AddButtonClick(Sender: TObject);
procedure EditButtonClick(Sender: TObject);
procedure DestroyButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
procedure PopupMenuItemsClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AddButtonClick(Sender: TObject);
var
index: Integer;
NewItem: TMenuItem;
begin
// The owner (PopupMenu1) will clean up this menu item.
NewItem := TMenuItem.Create(PopupMenu1); // Create the new item.
index := PopupMenu1.Items.Count;
PopupMenu1.Items.Add(NewItem);// Add it to the pop-up menu.
NewItem.Caption := 'Menu Item ' + IntToStr(index);
NewItem.Tag := index;
NewItem.OnClick :=
PopupMenuItemsClick; // Assign it an event handler.
end;
procedure TForm1.PopupMenuItemsClick(Sender: TObject);
begin
with Sender as TMenuItem do
begin
case Tag of
0: ShowMessage('first item clicked');
1: ShowMessage('second item clicked');
2: ShowMessage('third item clicked');
3: ShowMessage('fourth item clicked');
end;
end;
end;
{
To edit or destroy an item, grab its pointer
using the Items property.
procedure TForm1.EditButtonClick(Sender: TObject);
var
ItemToEdit: TMenuItem;
begin
ItemToEdit := PopupMenu.Items[1];
ItemToEdit.Caption := 'Changed Caption';
end;
procedure TForm1.DestroyButtonClick(Sender: TObject);
var
ItemToDelete: TMenuItem;
begin
ItemToDelete := PopupMenu.Items[2];
ItemToDelete.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
index: Integer;
NewItem: TMenuItem;
begin
for index := 0 to 3 do
begin
// The owner (PopupMenu1) will clean up this menu item.
NewItem := TMenuItem.Create(PopupMenu1); // Create the new item.
PopupMenu1.Items.Add(NewItem);// Add it to the pop-up menu.
NewItem.Caption := 'Menu Item ' + IntToStr(index);
NewItem.Tag := index;
NewItem.OnClick :=
PopupMenuItemsClick; // Assign it an event handler.
end;
end;
But PopupMenu is not appearing when I clicked on addmenu button. Anyone can find what is the reason why Popupmenu is not appearing when form is loaded or any button clicked.
your code not what you really need
use this code and it will work perfectly
procedure TForm1.PopupMenuItemsClick(Sender: TObject);
var ICount : Integer;
begin
ICount := TMenuItem(Sender).MenuIndex;
ShowMessage('Item Number '+ IntToStr(ICount+1) + ' Selected');
end;
procedure TForm1.AddClick(Sender: TObject);
var
Index: Integer;
NewItem: TMenuItem;
begin
NewItem := TMenuItem.Create(PopupMenu);
Index := PopupMenu.Items.Count;
PopupMenu.Items.Add(NewItem);
NewItem.Caption := 'Menu Item ' + IntToStr(Index);
NewItem.Tag := Index;
NewItem.OnClick := PopupMenuItemsClick;
PopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
I tested it with Delphi7, XE2 and XE3 its working
Add this line in the FormCreate or set this property in Object Inspector.
self.PopupMenu:=PopupMenu1;
This comments may help to solve the problem (i was having similar in old Delphi versions, i do not have XE to test on).
Never, ever create a component and let empty its .Name, allways
assign it a unique value (i see a lot of faulty interna code when let empty, since they can not be empty).
And allways assign properties and events to the componet prior to add
them onto their parent.
See this suggestions in the comments:
procedure TForm1.AddClick(Sender: TObject);
var
Index: Integer;
NewItem: TMenuItem;
begin
NewItem := TMenuItem.Create(PopupMenu);
Index := PopupMenu.Items.Count;
//PopupMenu.Items.Add(NewItem); // Not the correct place, see below
NewItem.Name : = 'SomeText' + IntToStr(Index); // Name them, with a unique name not starting with a number (also there is no need to put a number)
NewItem.Caption := 'Menu Item ' + IntToStr(Index);
NewItem.Tag := Index;
NewItem.OnClick := PopupMenuItemsClick;
PopupMenu.Items.Add(NewItem); // After properties has been set, never before
PopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
// Do not forget to free such menu item somewhere on your code, obviously not here
end;
And with menus, remember to free the items created, they do not free by them selfs and names will be in use next time.

How can a control be notified when its parent receives and loses focus in Delphi?

As the title says, I'd like a component (say, a label) to be notified when it's parent (say, a panel) receives and loses focus. I wandered a bit in Delphi source, in hope of using TControl.Notify, but it's only used to notify child controls of some property changes like font and color. Any suggestions?
Whenever the active control in an application changes, a CM_FOCUSCHANGED message is broadcast to all controls. Simply intercept it, and act accordingly.
Also, I assumed that by when it's parent (say, a panel) receives and loses focus you mean whenever a (nested) child control on that parent/panel receives or loses focus.
type
TLabel = class(StdCtrls.TLabel)
private
function HasCommonParent(AControl: TWinControl): Boolean;
procedure CMFocusChanged(var Message: TCMFocusChanged);
message CM_FOCUSCHANGED;
end;
procedure TLabel.CMFocusChanged(var Message: TCMFocusChanged);
const
FontStyles: array[Boolean] of TFontStyles = ([], [fsBold]);
begin
inherited;
Font.Style := FontStyles[HasCommonParent(Message.Sender)];
end;
function TLabel.HasCommonParent(AControl: TWinControl): Boolean;
begin
Result := False;
while AControl <> nil do
begin
if AControl = Parent then
begin
Result := True;
Break;
end;
AControl := AControl.Parent;
end;
end;
If you don't like to subclass TJvGradientHeader, then it is possible to design this generically by the use of Screen.OnActiveControlChange:
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FHeaders: TList;
procedure ActiveControlChanged(Sender: TObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FHeaders := TList.Create;
FHeaders.Add(Label1);
FHeaders.Add(Label2);
Screen.OnActiveControlChange := ActiveControlChanged;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FHeaders.Free;
end;
function HasCommonParent(AControl: TWinControl; AMatch: TControl): Boolean;
begin
Result := False;
while AControl <> nil do
begin
if AControl = AMatch.Parent then
begin
Result := True;
Break;
end;
AControl := AControl.Parent;
end;
end;
procedure TForm1.ActiveControlChanged(Sender: TObject);
const
FontStyles: array[Boolean] of TFontStyles = ([], [fsBold]);
var
I: Integer;
begin
for I := 0 to FHeaders.Count - 1 do
TLabel(FHeaders[I]).Font.Style :=
FontStyles[HasCommonParent(Screen.ActiveControl, TLabel(FHeaders[I]))];
end;
Note that I chose TLabel to demonstrate this works also for TControl derivatives.

How can I filter the contents of a combo box based on what's been typed?

We have a combo box with more than 100 items.
We want to filter out the items as we enter characters in combo box. For example if we entered 'ac' and click on the drop down option then we want it to display items starting with 'ac' only.
How can I do this?
Maybe you'd be happier using the autocompletion features built in to the OS. I gave an outline of how to do that here previously. Create an IAutoComplete object, hook it up to your combo box's list and edit control, and the OS will display a drop-down list of potential matches automatically as the user types. You won't need to adjust the combo box's list yourself.
To expand on Rob's answer about using the OnChange event, here is an example of how to do what he suggests.
procedure TForm1.FormCreate(Sender: TObject);
begin
FComboStrings := TStringList.Create;
FComboStrings.Add('Altair');
FComboStrings.Add('Alhambra');
FComboStrings.Add('Sinclair');
FComboStrings.Add('Sirius');
FComboStrings.Add('Bernard');
FComboStrings.Sorted := True;
ComboBox1.AutoComplete := False;
ComboBox1.Items.Text := FComboStrings.Text;
ComboBox1.Sorted := True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FComboStrings);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
var
Filter: string;
i: Integer;
idx: Integer;
begin
// Dropping down the list puts the text of the first item in the edit, this restores it
Filter := ComboBox1.Text;
ComboBox1.DroppedDown := True;
ComboBox1.Text := Filter;
ComboBox1.SelStart := Length(Filter);
for i := 0 to FComboStrings.Count - 1 do
if SameText(LeftStr(FComboStrings[i], Length(ComboBox1.Text)), ComboBox1.Text) then
begin
if ComboBox1.Items.IndexOf(FComboStrings[i]) < 0 then
ComboBox1.Items.Add(FComboStrings[i]);
end
else
begin
idx := ComboBox1.Items.IndexOf(FComboStrings[i]);
if idx >= 0 then
ComboBox1.Items.Delete(idx);
end;
end;
My brief contribution working with objects in the combobox:
procedure FilterComboBox(Combo: TComboBox; DefaultItems: TStrings);
function Origin: TStrings;
begin
if Combo.Tag = 0 then
begin
Combo.Sorted := True;
Result := TStrings.Create;
Result := Combo.Items;
Combo.Tag := Integer(Result);
end
else
Result := TStrings(Combo.Tag);
end;
var
Filter: TStrings;
I: Integer;
iSelIni: Integer;
begin
if(Combo.Text <> EmptyStr) then
begin
iSelIni:= Length(Combo.Text);
Filter := TStringList.Create;
try
for I := 0 to Origin.Count - 1 do
if AnsiContainsText(Origin[I], Combo.Text) then
Filter.AddObject(Origin[I], TObject(Origin.Objects[I]));
Combo.Items.Assign(Filter);
Combo.DroppedDown:= True;
Combo.SelStart := iSelIni;
Combo.SelLength := Length(Combo.Text);
finally
Filter.Free;
end;
end
else
Combo.Items.Assign(DefaultItems);
end;
You can handle the combo box's OnChange event. Keep a master list of all items separate from the UI control, and whenever the combo box's edit control changes, adjust the combo box's list accordingly. Remove items that don't match the current text, or re-add items from the master list that you removed previously.
As Rob already answered, you could filter on the OnChange event, see the following code example. It works for multiple ComboBoxes.
{uses}
Contnrs, StrUtils;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ComboBox2: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBoxChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FComboLists: TList;
procedure FilterComboBox(Combo: TComboBox);
end;
implementation
{$R *.dfm}
procedure TForm1.ComboBoxChange(Sender: TObject);
begin
if Sender is TComboBox then
FilterComboBox(TComboBox(Sender));
end;
procedure TForm1.FilterComboBox(Combo: TComboBox);
function Origin: TStrings;
begin
if Combo.Tag = 0 then
begin
Combo.Sorted := True;
Result := TStringList.Create;
Result.Assign(Combo.Items);
FComboLists.Add(Result);
Combo.Tag := Integer(Result);
end
else
Result := TStrings(Combo.Tag);
end;
var
Filter: TStrings;
I: Integer;
begin
Filter := TStringList.Create;
try
for I := 0 to Origin.Count - 1 do
if AnsiStartsText(Combo.Text, Origin[I]) then
Filter.Add(Origin[I]);
Combo.Items.Assign(Filter);
Combo.SelStart := Length(Combo.Text);
finally
Filter.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FComboLists := TObjectList.Create(True);
// For Each ComboBox, set AutoComplete at design time to false:
ComboBox1.AutoComplete := False;
ComboBox2.AutoComplete := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FComboLists.Free;
end;

Resources