delphi custom component with default popupmenu item - delphi

I use a custom listview component and I need it to have a popupmenu item "copy data to clipboard". If there is no assigned popup, I create one and add the menuitem, if there is already a menu assigned, add the item to the current popup. Tried to put the code in the constructor, but then I realized, that popupmenu is still not created or associated to my listview. So any idea when to create my default item?
constructor TMyListView.Create(AOwner: TComponent);
var
FpopupMenu: TPopupMenu;
begin
inherited;
.....
FPopUpMenuItem := TMenuItem.Create(self);
FPopUpMenuItem.Caption := 'Copy data to clipboard';
FPopUpMenuItem.OnClick := PopupMenuItemClick;
if assigned(PopupMenu) then begin
popupMenu.Items.Add(FPopUpMenuItem);
end
else begin
FpopupMenu := TPopupMenu.Create(self);
FpopupMenu.Items.Add(FPopUpMenuItem);
PopupMenu := FpopupMenu;
end;
...
end;

Override the virtual TControl.DoContextPopup() method, eg:
type
TMyListView = class(TListView)
protected
...
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
...
end;
procedure TMyListView.DoContextPopup(MousePos: TPoint; var Handled: Boolean);
var
LPopupMenu: TPopupMenu;
LItem: TMenuItem;
function IsSameEvent(const E1, E2: TNotifyEvent): Boolean;
begin
Result := (TMethod(E1).Code = TMethod(E2).Code) and
(TMethod(E1).Data = TMethod(E2).Data);
end;
begin
inherited DoContextPopup(MousePos, Handled);
if Handled then Exit;
LPopupMenu := PopupMenu;
if not Assigned(LPopupMenu) then
begin
LPopupMenu := TPopupMenu.Create(Self);
PopupMenu := LPopupMenu;
end;
for I := 0 to LPopupMenu.Items.Count-1 do
begin
LItem := LPopupMenu.Items[I];
if IsSameEvent(LItem.OnClick, PopupMenuItemClick) then
Exit;
end;
LItem := TMenuItem.Create(Self);
LItem.Caption := 'Copy data to clipboard';
LItem.OnClick := PopupMenuItemClick;
LPopupMenu.Items.Add(LItem);
end;

The accepted answer indeed works perfectly - unless you add keyboard shortcuts to your menu item. If you do, these won't work before the popup menu has been accessed in some other way, because the items will not have been created.
If you need shortcuts, it may therefore be preferable to move the code from DoContextPopup to Loaded. Most simply,
procedure Loaded; override;
...
procedure Loaded;
var
MI: TMenuItem;
ItemCovered: boolean;
i: integer;
begin
inherited;
if not Assigned(PopupMenu) then
PopupMenu:=TPopupMenu.Create(self);
ItemCovered:=false;
for i := 0 to PopupMenu.Items.Count-1 do
if IsSameEvent(PopupMenu.Items[I].OnClick, CopyDataToClipboardClick) then begin
ItemCovered:=true;
break;
end;
if not ItemCovered then begin
MI:=TMenuItem.Create(PopupMenu);
MI.Caption:='Copy data to clipboard';
MI.OnClick:=CopyDataToClipboardClick;
MI.ShortCut:=ShortCut(Ord('C'),[ssShift,ssCtrl]);
PopupMenu.Items.Add(MI);
end;
end;
This won't check for popup menus added on runtime, but probably serve most cases better.

Related

ComboBox doesn't behave the same inside panel

Using some answers in StackOverflow I've created a searcheable TComboBox in Delphi. It works fine when you add it directly to a Form, but breaks as soon as you add it to a TPanel and I can't seem to figure out why.
Directly on the form:
After typing t:
Inside a panel:
After typing t:
Here is the component's code:
unit uSmartCombo;
interface
uses
Vcl.StdCtrls, Classes, Winapi.Messages, Controls;
type
TSmartComboBox = class(TComboBox)
private
FStoredItems: TStringList;
procedure FilterItems;
procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
procedure RedefineCombo;
procedure SetStoredItems(const Value: TStringList);
procedure StoredItemsChange(Sender: TObject);
protected
procedure KeyPress(var Key: Char); override;
procedure CloseUp; override;
procedure Loaded; override;
procedure DoExit; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property StoredItems: TStringList read FStoredItems write SetStoredItems;
end;
procedure Register;
implementation
uses
SysUtils, Winapi.Windows, Vcl.Forms;
procedure Register;
begin
RegisterComponents('Standard', [TSmartComboBox]);
end;
constructor TSmartComboBox.Create(AOwner: TComponent);
begin
inherited;
FStoredItems := TStringList.Create;
FStoredItems.OnChange := StoredItemsChange;
end;
destructor TSmartComboBox.Destroy;
begin
FStoredItems.Free;
inherited;
end;
procedure TSmartComboBox.DoExit;
begin
inherited;
RedefineCombo;
end;
procedure TSmartComboBox.Loaded;
var LParent: TWinControl;
LPoint: TPoint;
begin
inherited;
if Items.Count > 0 then
FStoredItems.Assign(Items);
AutoComplete := False;
Style := csDropDownList;
// The ComboBox doesn't behave properly if the parent is not the form.
// Workaround to pull it from any parenting
//if not (Parent is TForm) then
//begin
// LParent := Parent;
// while (not (LParent is TForm)) and Assigned(LParent) do
// LParent := LParent.Parent;
// LPoint := ClientToParent(Point(0,0), LParent);
// Parent := LParent;
// Left := LPoint.X;
// Top := LPoint.Y;
// BringToFront;
//end;
end;
procedure TSmartComboBox.RedefineCombo;
var S: String;
begin
if Style = csDropDown then
begin
if ItemIndex <> -1 then
S := Items[ItemIndex];
Style := csDropDownList;
Items.Assign(FStoredItems);
if S <> '' then
ItemIndex := Items.IndexOf(S);
end;
end;
procedure TSmartComboBox.SetStoredItems(const Value: TStringList);
begin
if Assigned(FStoredItems) then
FStoredItems.Assign(Value)
else
FStoredItems := Value;
end;
procedure TSmartComboBox.StoredItemsChange(Sender: TObject);
begin
if Assigned(FStoredItems) then
begin
RedefineCombo;
Items.Assign(FStoredItems);
end;
end;
procedure TSmartComboBox.KeyPress(var Key: Char);
begin
if CharInSet(Key, ['a'..'z']) and not (Style = csDropDown) then
begin
DroppedDown := False;
Style := csDropDown;
end;
inherited;
if not (Ord(Key) in [13,27]) then
DroppedDown := True;
end;
procedure TSmartComboBox.CloseUp;
begin
if Style = csDropDown then
RedefineCombo;
inherited;
end;
procedure TSmartComboBox.CNCommand(var AMessage: TWMCommand);
begin
inherited;
if (AMessage.Ctl = Handle) and (AMessage.NotifyCode = CBN_EDITUPDATE) then
FilterItems;
end;
procedure TSmartComboBox.FilterItems;
var I: Integer;
Selection: TSelection;
begin
SendMessage(Handle, CB_GETEDITSEL, WPARAM(#Selection.StartPos), LPARAM(#Selection.EndPos));
Items.BeginUpdate;
Try
if Text <> '' then
begin
Items.Clear;
for I := 0 to FStoredItems.Count - 1 do
if (Pos(Uppercase(Text), Uppercase(FStoredItems[I])) > 0) then
Items.Add(FStoredItems[I]);
end
else
Items.Assign(FStoredItems);
Finally
Items.EndUpdate;
End;
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;
end.
Any help in how I can proceed to figure out why this is happening would be greatly appreciated!
Edit 1:
After doing some extra debugging, I've noticed the messages being sent to the ComboBox differ from the ones inside the panel.
A CBN_EDITUPDATE is never sent, like #Sherlock70 mentioned in the comments, which makes the FilterItems procedure never trigger.
I've also noticed the form behaves strangely after using the ComboBox inside the panel, sometimes freezing and even not responding, like it gets stuck in a loop.
This unpredictable behavior has made me move away from this approach, and I'm probably going to take an alternate route to create a "searchable ComboBox".
Going to leave the question open if someone wants to figure it out and maybe even use the component.
I hope this will help someone in future even after 7 months of the question. Setting the style of a Combobox will destroy the window handle of that Combobox and create a new one. This means windows will free your control's Window Handle and create a new one.
You are setting your Combobx style while searching and this is wrong. Try removing Style := from your code and test it again you will get the same results for Combobox on a form and Combobox on a panel or other TWinControl. As you can see in the following code, setting Style will call RecreateWnd.
procedure TCustomComboBox.SetStyle(Value: TComboBoxStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if Value = csSimple then
ControlStyle := ControlStyle - [csFixedHeight] else
ControlStyle := ControlStyle + [csFixedHeight];
RecreateWnd;
end;
end;
RecreateWnd will call DestroyHandle()
procedure TWinControl.CMRecreateWnd(var Message: TMessage);
var
WasFocused: Boolean;
begin
WasFocused := Focused;
DestroyHandle;
UpdateControlState;
if WasFocused and (FHandle <> 0) then Windows.SetFocus(FHandle);
end;
Then DestroyHandle will call DestroyWnd() which will call DestroyWindowHandle().

How do I create ActionBars recursively at runtime?

I am writing a class which will map a large legacy application's TMainMenu hierarchy to TActionMainMenuBar items.
The most important method, which borrows heavily from a EDN CodeCentralC article by Steve Trevethen, looks like this. I apologize for the length, but this really is probably the shortest length of code I could meaningfully show in this case:
procedure TMainMenuSkin.DoLoadMenu(
ActionList: TCustomActionList;
Clients: TActionClients;
AMenu: TMenuItem;
SetActionList: Boolean = True;
bRecurseFlag:Boolean = False);
var
I: Integer;
J: Integer;
AC: TActionClientItem;
ca : TCustomAction;
newAction : TSkinnedMenuAction;
aci:TActionClientItem;
submenuitem : TMEnuItem;
procedure PopulateNodeFromMenuItem(menuitem:TMenuItem);
begin
newAction := TSkinnedMenuAction.Create(Application.MainForm);
menuitem.FreeNotification(newAction);
newAction.FMenuItem := menuitem;
newAction.Name := 'action_'+newAction.FMenuItem.Name;
FNewMenuActions.Add(newAction);
newAction.ActionList := ActionManager;
newAction.Tag := menuitem.Tag;
ca := newAction;
ca.ImageIndex := menuitem.ImageIndex;
ca.HelpContext := menuitem.HelpContext;
ca.Visible := menuitem.Visible;
ca.Checked := menuitem.Checked;
ca.Caption := menuitem.Caption;
ca.ShortCut := menuitem.ShortCut;
ca.Enabled := menuitem.Enabled;
ca.AutoCheck := menuitem.AutoCheck;
ca.Checked := menuitem.Checked;
ca.GroupIndex := menuitem.GroupIndex;
AC.ImageIndex := menuitem.ImageIndex;
AC.ShortCut := menuitem.ShortCut;
AC.Action := newAction;
end;
begin
if not Assigned(AMenu) then
exit;
AMenu.RethinkHotkeys;
AMenu.RethinkLines;
Clients.AutoHotKeys := False;
for I := 0 to AMenu.Count - 1 do
begin
AC := Clients.Add;
AC.Caption := AMenu.Items[I].Caption;
// Assign the Tag property to the TMenuItem for reference
AC.Tag := Integer(AMenu.Items[I]);
AC.Action := TContainedAction(AMenu.Items[I].Action);
AC.Visible := AMenu.Items[I].Visible;
// original sample code only created placeholders for submenus. I want to populate
// fully because I need the actions and their keyboard shortcuts to exist.
submenuitem := AMenu.Items[I];
if submenuitem.Count > 0 then
begin
if not bRecurseFlag then
AC.Items.Add // old busted way to work
else
begin
// How do I recursively populate the Action Clients menu?
DoLoadMenu(ActionList, AC.ActionClients, submenuitem, true);
end;
end
else
if ((AMenu.Items[I].Caption <> '') and (AMenu.Items[I].Action = nil) and
(AMenu.Items[I].Caption <> '-')) then
begin
PopulateNodeFromMenuItem( AMenu.Items[I] );
end;
AC.Caption := AMenu.Items[I].Caption;
AC.ImageIndex := AMenu.Items[I].ImageIndex;
AC.HelpContext := AMenu.Items[I].HelpContext;
AC.ShortCut := AMenu.Items[I].ShortCut;
AC.Visible := AMenu.Items[I].Visible;
end;
end;
The most important line above is this one, and it's also the one
that is wrong:
DoLoadMenu(ActionList, AC.ActionClients, submenuitem, true);
If the code is written like that, then I get all the menu items displayed in a flattened form. So I need something like AC.GetMeSubItems.ActionClients in the line above,
but I can't figure out what it is. AC is of type TActionClientItem and is a toolbar button itself also created at runtime.
What I can't figure out for the life of me is, if I need to populate the Actions list and the menu items all at once, recursively, how do I do it? Perhaps my thinking is constrained by the sample code I started out with here. It seems like I'm one line of code away from knowing how to do this.
I have a feeling that I'm just not understanding very well the complex hiearchical relationships of the various classes I'm messing with here.
Update: The following SEEMS to work, but I don't trust myself.
aci := AC.Items.Add;
DoLoadMenu(ActionList, aci.Items, submenuitem, true);
Here's some code that I once wrote or found somewhere and which seems to do what you want to achieve: it is a converter class which copies the items of a Mainmenu to an ActionMainMenubar. It has some issues, but hopefully you can catch the point how it works.
The component assumes that you have a completed MainMenu on a form. You also need a TActionManager and an empty TActionMainMenubar. You create an instance of the TActionbarConverter in the OnCreate event of the MainForm, and assign its properties correspondingly, something like this:
procedure TForm1.FormCreate(Sender: TObject);
begin
with TActionbarConverter.Create(self) do begin
Form := self;
ActionManager := Actionmanager1;
ActionMainMenubar := ActionMainmenubar1;
end;
end;
You can change properties of the ActionManager, or use your own ColorMap to modify the appearance.
I hope that I don't get banned here by posting almost 400 lines of code here (don't know how to upload files...).
unit ActnbarCnv;
interface
uses
Classes, Menus, Forms, ComCtrls, ActnList, ActnMan, ActnMenus,
StdStyleActnCtrls, XPStyleActnCtrls;
type
TActionbarConverter = class(TComponent)
private
FForm : TCustomForm;
FMainMenu : TMainMenu;
FMainMenuToolbar : TToolbar;
FActionManager : TActionManager;
FActionMainMenubar : TActionMainMenubar;
FNewMenuActions : TList;
procedure ActionMainMenuBar_ExitMenuLoop(Sender:TCustomActionMenuBar;
Cancelled: Boolean);
procedure ActionMainMenubar_Popup(Sender:TObject; Item:TCustomActionControl);
procedure SetActionMainMenubar(Value:TActionMainMenubar);
procedure SetActionManager(Value:TActionManager);
procedure SetForm(Value:TCustomForm);
protected
procedure AnalyzeForm;
procedure Loaded; override;
procedure LoadMenu(ActionList: TCustomActionList; Clients: TActionClients;
AMenu: TMenuItem; SetActionList: Boolean = True);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure ProcessMenu;
procedure UpdateActionMainMenuBar(Menu: TMenu);
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure Update;
published
property Form : TCustomForm read FForm write SetForm;
property ActionManager : TActionManager read FActionManager write SetActionManager;
property ActionMainMenubar : TActionMainMenubar read FActionMainMenubar write SetActionMainMenubar;
end;
//==============================================================================
implementation
//==============================================================================
uses
SysUtils;
//==============================================================================
{ TABMenuAction -
This class is a special ActionBand menu action that stores the TMenuItem
that it is associated with so that if it is executed it can actually call the
TMenuItem.Click method simulating an actual click on the TMenuItem itself. }
type
TABMenuAction = class(TCustomAction)
private
FMenuItem: TMenuItem;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
destructor Destroy; override;
procedure ExecuteTarget(Target: TObject); override;
function HandlesTarget(Target: TObject): Boolean; override;
end;
//------------------------------------------------------------------------------
destructor TABMenuAction.Destroy;
begin
if Assigned(FMenuItem) then FMenuItem.RemoveFreeNotification(Self);
inherited;
end;
//------------------------------------------------------------------------------
procedure TABMenuAction.ExecuteTarget(Target: TObject);
begin
if Assigned(FMenuItem) then FMenuItem.Click;
end;
//------------------------------------------------------------------------------
function TABMenuAction.HandlesTarget(Target: TObject): Boolean;
begin
Result := True;
end;
//------------------------------------------------------------------------------
procedure TABMenuAction.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FMenuItem)
then FMenuItem := nil;
end;
//------------------------------------------------------------------------------
// TActionbarConverter
//------------------------------------------------------------------------------
constructor TActionbarConverter.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FNewMenuActions := TList.Create;
if (AOwner is TCustomForm) then SetForm(TCustomForm(AOwner));
end;
//------------------------------------------------------------------------------
destructor TActionbarConverter.Destroy;
begin
FNewMenuActions.Free;
inherited Destroy;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.ActionMainMenuBar_ExitMenuLoop(Sender:TCustomActionMenuBar;
Cancelled: Boolean);
var
I: Integer;
AnAction: TObject;
begin
// Clear the top level menu sub item and add a single dummy item which
// will cause them to be regenerated on the next menu loop. This is done
// because the IDE's menus can be very dynamic and this ensures that the
// menus will always be up-to-date.
for I := 0 to FActionManager.ActionBars[0].Items.Count - 1 do begin
FActionManager.ActionBars[0].Items[I].Items.Clear;
FActionManager.ActionBars[0].Items[I].Items.Add;
end;
// Any menuitems not linked to an action had one dynamically created for them
// during the menu loop so now we need to destroy them
while FNewMenuActions.Count > 0 do begin
AnAction := TObject(FNewMenuActions.Items[0]);
AnAction.Free;
FNewMenuActions.Delete(0);
end;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.ActionMainMenubar_Popup(Sender:TObject;
Item: TCustomActionControl);
begin
// If the tag is not zero then we've already populated this submenu...
if Item.ActionClient.Items[0].Tag <> 0 then exit;
// ...otherwise this is the first visit to this submenu and we need to
// populate the actual ActionClients collection.
if Assigned(TMenuItem(Item.ActionClient.Tag).OnClick) then
TMenuItem(Item.ActionClient.Tag).OnClick(TMenuItem(Item.ActionClient.Tag));
Item.ActionClient.Items.Clear;
TMenuItem(Item.ActionClient.Tag).RethinkHotkeys;
LoadMenu(FActionManager, Item.ActionClient.Items, TMenuItem(Item.ActionClient.Tag), False);
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.AnalyzeForm;
var
i : integer;
begin
FMainMenu := nil;
FMainMenuToolbar := nil;
if Assigned(FForm) then begin
for i:=0 to FForm.ComponentCount-1 do
if (FForm.Components[i] is TMainMenu) then begin
FMainMenu := FForm.Components[i] as TMainMenu;
break;
end;
for i:=0 to FForm.ComponentCount-1 do
if (FForm.Components[i] is TToolbar) then begin
FMainMenuToolbar := FForm.Components[i] as TToolbar;
if FMainMenuToolbar.Menu = FMainMenu
then break
else FMainMenuToolbar := nil;
end;
end;
ProcessMenu;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.Loaded;
begin
AnalyzeForm;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.LoadMenu(ActionList: TCustomActionList;
Clients: TActionClients; AMenu: TMenuItem; SetActionList: Boolean = True);
{ This method dynamically builds the ActionBand menu from an existing
TMenuItem. }
var
I: Integer;
AC: TActionClientItem;
begin
AMenu.RethinkHotkeys;
AMenu.RethinkLines;
// Use the existing hotkeys from the TMenuItem
Clients.AutoHotKeys := False;
for I := 0 to AMenu.Count - 1 do begin
AC := Clients.Add;
AC.Caption := AMenu.Items[I].Caption;
// Assign the Tag property to the TMenuItem for reference
AC.Tag := Integer(AMenu.Items[I]);
AC.Action := TContainedAction(AMenu.Items[I].Action);
AC.Visible := AMenu.Items[I].Visible;
// If the TMenuItem has subitems add an ActionClient placeholder.
// Submenus are only populated when the user selects the parent item of the
// submenu.
if AMenu.Items[I].Count > 0 then
AC.Items.Add // Add a dummy indicating this item can/should be dynamically built
else
if (AMenu.Items[I].Caption <> '')
and (AMenu.Items[I].Action = nil)
and (AMenu.Items[I].Caption <> '-')
then begin
// The TMenuItem is not connected to an action so dynamically create
// an action.
AC.Action := TABMenuAction.Create(self); //Application.MainForm);
AMenu.Items[I].FreeNotification(AC.Action);
TABMenuAction(AC.Action).FMenuItem := AMenu.Items[I];
FNewMenuActions.Add(AC.Action);
AC.Action.ActionList := FActionManager;
AC.Action.Tag := AMenu.Items[I].Tag;
TCustomAction(AC.Action).ImageIndex := AMenu.Items[I].ImageIndex;
TCustomAction(AC.Action).HelpContext := AMenu.Items[I].HelpContext;
TCustomAction(AC.Action).Visible := AMenu.Items[I].Visible;
TCustomAction(AC.Action).Checked := AMenu.Items[I].Checked;
TCustomAction(AC.Action).Caption := AMenu.Items[I].Caption;
TCustomAction(AC.Action).ShortCut := AMenu.Items[I].ShortCut;
TCustomAction(AC.Action).Enabled := AMenu.Items[I].Enabled;
TCustomAction(AC.Action).AutoCheck := AMenu.Items[I].AutoCheck;
TCustomAction(AC.Action).Checked := AMenu.Items[I].Checked;
TCustomAction(AC.Action).GroupIndex := AMenu.Items[I].GroupIndex;
AC.ImageIndex := AMenu.Items[I].ImageIndex;
AC.ShortCut := AMenu.Items[I].ShortCut;
end;
AC.Caption := AMenu.Items[I].Caption;
AC.ImageIndex := AMenu.Items[I].ImageIndex;
AC.HelpContext := AMenu.Items[I].HelpContext;
AC.ShortCut := AMenu.Items[I].ShortCut;
AC.Visible := AMenu.Items[I].Visible;
end;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) then
if (AComponent=FForm) then SetForm(nil);
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.ProcessMenu;
begin
if FMainMenu <> nil then begin
if FMainMenutoolbar <> nil then begin
FMainMenutoolbar.Menu := nil;
FMainMenutoolbar.Visible := false;
end;
FForm.Menu := nil;
if FActionManager=nil then begin
FActionManager := TActionManager.Create(self);
// FActionManager.Style := XPStyle;
end else
FActionManager.Actionbars.Clear;
FActionManager.Images := FMainMenu.Images;
FActionManager.Actionbars.Add;
if FActionMainMenubar=nil then begin
FActionMainMenubar := TActionMainMenubar.Create(self);
if (FMainMenuToolbar <> nil)
then FActionMainMenubar.Parent := FMainMenuToolbar.Parent
else FActionMainMenubar.Parent := FForm;
end;
FActionMainMenubar.ActionManager := FActionManager;
FActionMainMenubar.OnPopup := ActionMainMenubar_Popup;
FActionMainMenubar.OnExitMenuLoop := ActionMainMenubar_ExitMenuLoop;
UpdateActionMainMenubar(FMainMenu);
end;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.SetActionMainmenubar(Value:TActionMainMenubar);
begin
if Value=nil then begin
FActionMainMenubar := TActionMainMenubar.Create(self);
if FMainmenuToolbar <> nil
then FActionMainMenubar.Parent := FMainMenuToolbar.Parent
else FActionMainMenubar.Parent := FForm;
end else begin
FActionMainMenubar.Free;
FActionMainMenubar := value;
end;
Update;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.SetActionManager(value:TActionManager);
begin
if Value = nil then begin
FActionManager := TActionManager.Create(self);
FActionManager.Style := XPStyle;
end else begin
FActionManager := value;
// if FMainMenu <> nil then FActionManager.Images := FMainMenu.Images;
end;
Update;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.SetForm(value:TCustomForm);
begin
if FForm <> Value then begin
FForm := Value;
AnalyzeForm;
end;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.Update;
begin
AnalyzeForm;
end;
//------------------------------------------------------------------------------
procedure TActionbarConverter.UpdateActionMainMenuBar(Menu: TMenu);
{ This routine should probably also check for Enabled state although it would
be very wierd to have a top level menu disabled. }
function RefreshItems: Boolean;
var
I: Integer;
begin
Result := FMainMenu.Items.Count <> FActionManager.ActionBars[0].Items.Count;
if not Result then
for I := 0 to FMainMenu.Items.Count - 1 do
if AnsiCompareText(
FMainMenu.Items[I].Caption,
FActionManager.ActionBars[0].Items[I].Caption ) <> 0
then begin
Result := True;
break;
end;
end;
begin
if not (csLoading in FActionManager.ComponentState) and RefreshItems
then begin
// Clear any existing items and repopulate the TActionMainMenuBar
FActionManager.ActionBars[0].Items.Clear;
FActionManager.ActionBars[0].ActionBar := nil;
LoadMenu(FActionManager, FActionManager.ActionBars[0].Items, FMainMenu.Items);
FActionManager.ActionBars[0].ActionBar := FActionMainMenuBar;
// Update the size of the main menu
with FActionMainMenuBar do
SetBounds(
0,
0,
Controls[ControlCount-1].BoundsRect.Right + 2 + FActionMainMenuBar.HorzMargin,
Height
);
end;
end;
end.

Delphi IDE Menu integration - INTAServices

I successfully installed my menu item inside Delphi using INTAServices40 but the problem is - menu is missing the next time Delphi starts?! Actually, two menu items are installed; One under Help menu which is ALWAYS shown (IOTAWizardMenu), but the one under Tools menu (TEST menu item) is missing the next time Delphi starts. How to fix this?
unit TESTMENU;
interface
uses
ToolsAPI, Classes, Windows, vcl.Menus, vcl.dialogs;
type
TCustomMenuItem = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
function GetIDString: string;
function GetName: string;
function GetState: TWizardState;
// Launch the AddIn
procedure Execute;
function GetMenuText: string;
end;
TCustomMenuHandler = class(TObject)
// Handle custom menu
procedure HandleClick(Sender: TObject);
end;
procedure Register;
implementation
var
mnuitem: TMenuItem;
CustomMenuHandler: TCustomMenuHandler;
procedure TCustomMenuItem.Execute;
begin
ShowMessage('IOTAWizardMenu based menu item');
end;
function TCustomMenuItem.GetIDString: string;
begin
Result := 'TMS.MenuSample';
end;
function TCustomMenuItem.GetMenuText: string;
begin
Result := 'IOTAWizardMenu';
end;
function TCustomMenuItem.GetName: string;
begin
Result := 'TMSMenuSample';
end;
function TCustomMenuItem.GetState: TWizardState;
begin
Result := [wsEnabled];
end;
procedure TCustomMenuHandler.HandleClick(Sender: TObject);
begin
ShowMessage('INTAServices40.MainMenu based menu item');
end;
procedure AddIDEMenu;
var
NTAServices: INTAServices40;
begin
NTAServices := BorlandIDEServices as INTAServices40;
// avoid inserting twice
if NTAServices.MainMenu.Items[9].Find('TEST') = nil then
begin
CustomMenuHandler := TCustomMenuHandler.Create;
mnuitem := TMenuItem.Create(nil);
mnuitem.Caption := 'TEST';
mnuitem.OnClick := CustomMenuHandler.HandleClick;
NTAServices.MainMenu.Items[9].Add(mnuitem)
end;
end;
procedure RemoveIDEMenu;
var
NTAServices: INTAServices40;
begin
if Assigned(mnuitem) then
begin
NTAServices := BorlandIDEServices as INTAServices40;
NTAServices.MainMenu.Items[9].Remove(mnuitem);
mnuitem.Free;
if Assigned(CustomMenuHandler) then
CustomMenuHandler.Free;
end;
end;
procedure Register;
begin
AddIDEMenu;
RegisterPackageWizard(TCustomMenuItem.Create);
end;
initialization
mnuitem := nil;
CustomMenuHandler := nil;
finalization
RemoveIDEMenu;
end.
So, my first problem is how to get menu item TEST shown each time Delphi starts.. Also, I would like to add icon next to the menu item TEST. Any directions?
Thank you
EDIT:
I just found out my package is delayed loading. Reading the Internet people say ForceDemandLoadState(dlDisable) should be called. But, this is not helping me also....
NTAServices.MainMenu.Items[9] may return different things at different times as the IDE is loading its packages, also there are menu items whose sub-items are managed by the IDE at runtime (e.g. the Window menu).
You could look up the Help menu item component by name:
procedure AddIDEMenu;
var
HelpMenu: TComponent;
begin
HelpMenu := Application.MainForm.FindComponent('HelpMenu');
if (HelpMenu is TMenuItem) and (TMenuItem(HelpMenu).Find('TEST') = nil) then
begin
CustomMenuHandler := TCustomMenuHandler.Create;
mnuitem := TMenuItem.Create(nil);
mnuitem.Caption := 'TEST';
mnuitem.OnClick := CustomMenuHandler.HandleClick;
TMenuItem(HelpMenu).Add(mnuitem);
end;
end;
procedure RemoveIDEMenu;
var
HelpMenu: TComponent;
begin
if Assigned(mnuitem) then
begin
HelpMenu := Application.MainForm.FindComponent('HelpMenu');
if HelpMenu is TMenuItem then
TMenuItem(HelpMenu).Remove(mnuitem);
mnuitem.Free;
CustomMenuHandler.Free;
end;
end;

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