Custom Button , OnClick with PopupMenu - delphi

so I've created a custom Button based on cxButton . I wish to show a Popupmenu when I click this button . But for some reason the Popupmenu is not Showing up.
I don't even get a error , I have no idea why .
type
TcxGridButton = class(TcxButton)
private
FGridView : TcxGridDBTableView;
FPopup : TPopupMenu;
procedure AutoSize(Sender : TObject);
procedure ClearFilter(Sender : TObject);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
procedure Click; override;
published
property GridView : TcxGridDBTableView read FGridView write FGridView;
end;
And here is the Part where I Create the Popupmenu
constructor TcxGridButton.Create(AOwner: TComponent);
var Item : TMenuItem;
P : TPoint;
begin
inherited;
Text:='Options';
FPopup := TPopupMenu.Create(Self);
Item := TMenuItem.Create(FPopup);
Item.Caption:='Nach Excel exportieren';
Item := TMenuItem.Create(FPopup);
Item.Caption:='Automatische Größenanpassung';
Item.OnClick:=AutoSize;
Item := TMenuItem.Create(FPopup);
Item.Caption:='Filter löschen';
Item.OnClick:=ClearFilter;
end;
Now when I place this Button on the Form it has the Text Options displayed imediately so the Constructor seems to be running ok .
But when I click this button , I get the Click , Self.ToString and Done.
But the Popup menu never Pops up . What is my mistake ?
procedure TcxGridButton.Click;
begin
inherited; // call the inherited Click method.
ShowMessage('CLICK');
if not Assigned(FGridView) then Exit;
ShowMessage(Self.ToString);
FPopup.Popup(0,0);
ShowMessage('DONE');
end;

The answer is pretty simple - you forgot to add the items to your popup menu:
{ after creating each item }
FPopup.Items.Add(Item);
In case you're not bound to TCxButton you can use standard VCL button that provides the functionality you're trying to implement via property Style set to bsSplitButton and property DropDownMenu. Otherwise you can at least study VCL's TCustomButton source code as an inspiration for your own implementation.

Related

Form Controll ( Edit , ComboBox , Memo etc ) Query isModified?

when a User adds or changes something in the Programm , on the FormQuery I check if there was something modified and no Save done and I warn the user that if he quits all data will be lost .
Problem is I am checking the Components one at a time . Edit has Modified , but DateTimePicker has none for example .
My question is : if possible how can you check with one command perhaps if anything on the Form was altered ? Any Control ?
UPDATE
I was thinking about something universal if such a thing exists , something like this but for every controller that can be altered by the user in any way .
Drop 4 TEdit's on the form and one TLabel .
procedure TForm1.SomethingChanged(Sender: TObject);
begin
Label1.Caption:='SOMETHING CHANGED!';
end;
on TForm.Create I do this :
procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
Child : TComponent;
begin
for i := 0 to ComponentCount-1 do
begin
Child := Components[i];
if Child is TEdit then
TEdit(Child).OnChange:=SomethingChanged;
if Child is TDateTimePicker then
TDateTimePicker(Child).OnChange:=SomethingChanged;
if Child is TComboBox then
TComboBox(Child).OnChange:=SomethingChanged;
end;
end;
I Could make this for all controls like : Editors , DateTimePickers , ComboBoxes etc... but I was thinking that maybe there is some cool "secret" smarter way to do this .
Thank you
UPDATE 2
now I have another problem , dunno if possible . Say one of the TEdit's have a onChange event defined like this :
procedure TForm1.Edit1Change(Sender: TObject);
begin
Label2.Caption:='THIS WAS EDIT1CHANGE';
end;
When the Application starts this is reset to my custom onChange event and this one is never run .
Is it possible to somehow chain onChange events ?
Like I have the one where I only check if something changed ... and yet I allow the TEdit to execute it's "normal" onChange event .
Thank you
I think The key Here is that these components are mostly TWinControl descendant, So why not hook to their OnChange Message CM_CHANGED and this way you will not have a problem with OnChange event chaining as you say it (I wish Delphi had some thing like C# += operator when it comes to events).
you will need the following classes to achieve this
1. TListener
TListener = class
private
FOnChangeHappend: TNotifyEvent;
FWinControl: TWinControl;
FMsgToListen: Cardinal;
FOldWndProc: System.Classes.TWndMethod;
procedure FWindowProc(var Message: TMessage);
public
constructor Create(aWinControl: TWinControl; aMsg: Cardinal);
Destructor Destroy;
property OnChangeHappend: TNotifyEvent read FOnChangeHappend write FOnChangeHappend;
end;
{ TListener }
constructor TListener.Create(aWinControl: TWinControl; aMsg: Cardinal);
begin
FMsgToListen := aMsg;
FWinControl := aWinControl;
FOldWndProc := aWinControl.WindowProc;
aWinControl.WindowProc := FWindowProc;
end;
destructor TListener.Destroy;
begin
if Assigned(FOldWndProc) then
FWinControl.WindowProc := FOldWndProc;
inherited Destroy;
end;
procedure TListener.FWindowProc(var Message: TMessage);
begin
if ((Message.Msg = FMsgToListen) and (Assigned(FOnChangeHappend))) then
begin
FOnChangeHappend(FWinControl);
end;
FOldWndProc(Message);
end;
2. TListenerList
TListenerList = class
private
FListners: TObjectList<TListener>;
FOnChangeHappend: TNotifyEvent;
public
constructor Create;
Destructor Destroy;
procedure ListenTo(aWinControl: TWinControl; aMsg: Cardinal);
property OnChangeHappend: TNotifyEvent read FOnChangeHappend write FOnChangeHappend;
end;
{ TListenerList }
constructor TListenerList.Create;
begin
FListners := TObjectList<TListener>.Create;
FListners.OwnsObjects := True;
end;
destructor TListenerList.Destroy;
begin
FListners.Free;
end;
procedure TListenerList.ListenTo(aWinControl: TWinControl; aMsg: Cardinal);
var
aListener: TListener;
begin
aListener := TListener.Create(aWinControl, aMsg);
aListener.OnChangeHappend := FOnChangeHappend;
Flistners.Add(aListener);
end;
And you can use it like this in your form OnCreate event
procedure TForm8.FormCreate(Sender: TObject);
begin
FListenerList := TListenerList.Create();
FListenerList.OnChangeHappend := TextChanged;
FListenerList.ListenTo(DBEdit1, CM_CHANGED);
FListenerList.ListenTo(DBMemo1, CM_CHANGED);
FListenerList.ListenTo(DBComboBox1, CM_CHANGED);
FListenerList.ListenTo(DBCheckBox1, CM_CHANGED);
FListenerList.ListenTo(DBRichEdit1, CM_CHANGED);
FListenerList.ListenTo(Memo1, CM_CHANGED);
FListenerList.ListenTo(Edit1, CM_CHANGED);
FListenerList.ListenTo(ComboBox1, CM_CHANGED);
FListenerList.ListenTo(DateTimePicker1, CM_CHANGED);
FListenerList.ListenTo(CheckBox1, CM_CHANGED);
end;
procedure TForm8.TextChanged(Sender: TObject);
begin
memo2.Lines.Add(TWinControl(Sender).Name + 'Changed');
end;
but this message has a limitation. For example if the edit control had the text 'Hello' and you wanted to delete it (back key press) the Listener event will be fired five times (one for each letter) so instead you should use the CM_ENTER and CM_EXIT messages were you record the value of each TWinControl when entered (has focus) and compare that to its value when exited (lost focus).
This approach will work with any TWinControl descendant (pretty much any control that the user can interact with)
if you use dbedit,dbcombobax.. you can do control.
because
you must have linked them to a table or query.
you must use datasource for links.
if table1.state=dsedit then
begin
end;
Define a variable if you are using edit.
Assign value to the variable in the onchange event of all fields. Then check this variable.
procedure Tform1.editChange (Sender: TObject);
begin
variable_change:= 'YES';
end;
if variable_change = 'YES' then
begin
end;

How can I prevent duplication of sub components in Firemonkey compound component?

I am trying to write a compound component which is derived from TDummy. The component source is:
TMyObjectType=(otCube,otSphere);
TMyGameObject=class(TDummy)
private
FObj:TCustomMesh;
FMyObjectType: TMyObjectType;
procedure SetMyObjectType(const Value: TMyObjectType);
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
property MyObjectType:TMyObjectType read FMyObjectType write SetMyObjectType;
end;
{ TMyGameObject }
constructor TMyGameObject.Create(AOwner: TComponent);
begin
inherited;
MyObjectType:=otCube;
end;
destructor TMyGameObject.Destroy;
begin
FObj.Parent.RemoveObject(FObj);
FreeAndNil(FObj);
inherited;
end;
procedure TMyGameObject.SetMyObjectType(const Value: TMyObjectType);
begin
FMyObjectType := Value;
if(Assigned(FObj))then begin
FObj.Parent.RemoveObject(FObj);
FreeAndNil(FObj);
end;
case FMyObjectType of
otCube: FObj:=TCube.Create(Self);
otSphere: FObj:=TSphere.Create(Self);
end;
FObj.SetSubComponent(True);
FObj.Parent:=Self;
end;
after I register the component and put one instance on a TViewport3D in the code of a Tbutton I try to change the MyObjectType to otSphere.
MyGameObject1.MyObjectType:=otSphere;
but it seems there is nothing happening. So I wrote a piece of code as fallow.
procedure MyParseObj(obj:TFmxObject;var s:string);
var
i: Integer;
a:string;
begin
s:=s+obj.ClassName+'(';
a:='';
for i := 0 to obj.ChildrenCount-1 do begin
s:=s+a;
MyParseObj(obj.Children.Items[i],s);
a:=',';
end;
s:=s+')'
end;
and call it in another button.
procedure TForm1.Button2Click(Sender: TObject);
var s:string;
begin
s:='';
MyParseObj(myGameObject1,s);
ShowMessage(s);
end;
the result was strange.
if I press the button2 result is: TMyGameObject(TCube(),TCube())
and when I press the button1 and after that press button2 result is: TMyGameObject(TCube(),TSphere())
why there is two TCustomMesh as child in my object? (TCube and TSphere are derived from TCustomMesh)
how can I fix this?
and there is another test that I performed. if I create the object not in design time it work properly. problem happens if I put an instance of TMyGameObject in design time.
When you save a form (from the IDE) all controls and all their children are saved. If your control creates it's own children then you need to set Stored = False to prevent them being streamed by the IDE.

Creating a popup menu at runtime

I'm trying to simply create a popup menu (or context menu), add some items to it, and show it at the mouse location. All the examples I have found are doing this using the designer. I'm doing this from a DLL plugin, so there is no form/designer. The user will click a button from the main application which calls the execute procedure below. I just want something similar to a right click menu to appear.
My code obviously doesn't work, but I was hoping for an example of creating a popup menu during runtime instead of design time.
procedure TPlugIn.Execute(AParameters : WideString);
var
pnt: TPoint;
PopupMenu1: TPopupMenu;
PopupMenuItem : TMenuItem;
begin
GetCursorPos(pnt);
PopupMenuItem.Caption := 'MenuItem1';
PopupMenu1.Items.Add(PopupMenuItem);
PopupMenuItem.Caption := 'MenuItem2';
PopupMenu1.Items.Add(PopupMenuItem);
PopupMenu1.Popup(pnt.X, pnt.Y);
end;
You have to actually create instances of a class in Delphi before you can use them. The following code creates a popup menu, adds a few items to it (including an event handler for the click), and assigns it to the form. Note that you have to declare (and write) the HandlePopupItemClick event yourself like I've done).
In the interface section (add Menus to the uses clause):
type
TForm1 = class(TForm)
// Double-click the OnCreate in the Object Inspector Events tab.
// It will add this item.
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
// Add the next two lines yourself, then use Ctrl+C to
// generate the empty HandlePopupItem handler
FPopup: TPopupMenu;
procedure HandlePopupItem(Sender: TObject);
public
{ Public declarations }
end;
implementation
// The Object Inspector will generate the basic code for this; add the
// parts it doesn't add for you.
procedure TForm1.FormCreate(Sender: TObject);
var
Item: TMenuItem;
i: Integer;
begin
FPopup := TPopupMenu.Create(Self);
FPopup.AutoHotkeys := maManual;
for i := 0 to 5 do
begin
Item := TMenuItem.Create(FPopup);
Item.Caption := 'Item ' + IntToStr(i);
Item.OnClick := HandlePopupItem;
FPopup.Items.Add(Item);
end;
Self.PopupMenu := FPopup;
end;
// The Ctrl+C I described will generate the basic code for this;
// add the line between begin and end that it doesn't.
procedure TForm1.HandlePopupItem(Sender: TObject);
begin
ShowMessage(TMenuItem(Sender).Caption);
end;
Now I'll leave it to you to figure out how to do the rest (create and show it at a specific position).

dropdown-list of custom combobox in Delphi is closing right after comming up

I was looking for an easy way to use RichtText in a default combobox, but found nothing.
So I wrote this little Delphi(7) component, that is working so far.
How is works:
I'm calling "init" to replace the "Edit"-window inside a default combobox with a
runtime-created RichEdit. Size is taken from the Edit, and Edit is finally hidden.
Some event-handlers are included for change-detection and so on.
Problem:
If I click an item of the dropdown-list, the text is shown in the RichEdit.
If some text is entered inside the RichEdit and the dropdown-button is pressed again,
the dropdown-list is opened and closed in the next moment. After some clicks, the list
remains open and is working as expected.
Every time I click the list and change the RichEdit again, the same is happening.
Maybe I have to sent some messages to the combobox to get that fixed ?
I didn't find any solution on the web, so far. Maybe you have an idea.
Thanks for your help !
unit RichTextComboBox;
interface
uses SysUtils, Classes, Controls, StdCtrls, Windows, Messages, forms, Graphics, ComCtrls;
type
TRichTextComboBox = class(TComboBox)
private
FOnChange :TNotifyEvent;
EditHandle :Integer;
procedure proc_FOnComboChange(Sender: TObject);
protected
public
Rich :TRichEdit; // accessable from outside
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Init; // replace Edit in combobox with RichEdit
published
end;
procedure Register;
implementation
constructor TRichTextComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
// click in Combo-Drop-Down-List
procedure TRichTextComboBox.proc_FOnComboChange(Sender :TObject);
begin
if Rich.Text <> Items.Strings[ItemIndex] then begin
Rich.Text:= Items.Strings[ItemIndex];
end;
if assigned (FOnChange) then FOnChange(sender);
end;
procedure Register;
begin
RegisterComponents('TEST', [tRichTextComboBox]);
end;
destructor TRichTextComboBox.Destroy;
begin
if Rich <> nil then begin
RemoveControl(rich);
Rich.destroy;
end;
inherited Destroy;
end;
// Replace "Edit" with "RichEdit" in ComboBox
//
procedure TRichTextComboBox.init;
var h :integer;
rect :trect;
wndpos :TWindowPlacement;
begin
h:= FindWindowEx(
self.Handle,
0, // handle to a child window
'Edit', // class name
nil
);
Rich:= TRichEdit.create(self);
rich.Parent:= self;
if h <> 0 then begin
EditHandle:= h;
GetWindowRect(h, rect);
// configure RichEdit
GetWindowPlacement(h, #wndpos); // RichEdit with position and size of Edit
rich.BorderStyle:= bsNone;
rich.Text:= self.Text;
rich.Font.Style:= [fsbold, fsItalic];
rich.Top:= wndpos.rcNormalPosition.top;
rich.Left:= wndpos.rcNormalPosition.Left;
rich.Width:= rect.Right - rect.Left;
rich.Height:= rect.Bottom-rect.Top;
rich.WantReturns:= false; // just one line
rich.WordWrap:= false; // just one line
rich.ParentColor:= true; // just one line
rich.Visible:= true;
showwindow(h, sw_hide); // hide Edit
end;
// if drop-down-combo-list is clicked
// change the string of the RichEdit
FOnChange:= self.OnChange; // save original OnChange of ComboBox
rich.OnChange:= FOnChange;
self.OnChange:= proc_FOnComboChange;
end;
end.
Finally I found the solution :-)
The RichEdit is holding the Focus, which causes the drop-down-list not to stay open after entering s.th. in the RichEdit.
This procedure sets the Focus back to the Combobox before it is opening. So everything works as expected.
Code to be inserted:
after protected enter:
procedure DropDown; override;
the procedure looks like this:
procedure TRichTextComboBox.DropDown;
begin
Self.SetFocus;
inherited DropDown;
end;
I prefer this approach, because I don't want to mess around with the OwnerDraw-problems that we can read on many pages. (Some things are still missing: Upkey/Downkey...)

Display a ToolTip hint on a disabled menu item of a popup menu

So I have a TMenuItem attached to a TAction on a TPopupMenu for a TDBGrid (actually 3rd party, but you get the idea). Based on the selected row in the grid, the TAction is enabled or disabled. What I want is to be able to display a hint to the user explaining why the item is disabled.
As far as why I want a hint on a disabled menu item, lets just say I am in agreement with Joel.
All TMenuItem's have a hint property, but as best I can tell they are only used the the TApplicationEvent.OnHint event handler to stick the hint in a TStatusBar or some other special processing. I found an article on how to create your own even window for a TMainMenu's TMenuItems, but it doesn't work on a TPopupMenu's TMenuItem. It works by handling the WM_MENUSELECT message, which as far as I can tell is not sent on a TPopupMenu.
WM_MENUSELECT is indeed handled for menu items in popup menus also, but not by the windows proc of the form containing the (popup) menu, but by an invisible helper window created by Menus.PopupList. Luckily you can (at least under Delphi 5) get at this HWND via Menus.PopupList.Window.
Now you can use the old-fashioned way to subclass a window, as described for example in this CodeGear article, to handle WM_MENUSELECT also for popup menus. The HWND will be valid from after the first TPopupMenu is created to before the last TPopupMenu object is destroyed.
A quick test with the demo app in the linked article in the question should reveal whether this is going to work.
Edit: It does indeed work. I changed the linked example to show hints also for the popup menu. Here are the steps:
Add a handler for OnDestroy, a member variable for the old window proc and a method for the new window proc to the form:
TForm1 = class(TForm)
...
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEvents1Hint(Sender: TObject);
private
miHint : TMenuItemHint;
fOldWndProc: TFarProc;
procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
procedure PopupListWndProc(var AMsg: TMessage);
end;
Change the OnCreate handler of the form to subclass the hidden PopupList window, and implement the proper restoration of the window proc in the OnDestroy handler:
procedure TForm1.FormCreate(Sender: TObject);
var
NewWndProc: TFarProc;
begin
miHint := TMenuItemHint.Create(self);
NewWndProc := MakeObjectInstance(PopupListWndProc);
fOldWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(NewWndProc)));
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
NewWndProc: TFarProc;
begin
NewWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(fOldWndProc)));
FreeObjectInstance(NewWndProc);
end;
Implement the subclassed window proc:
procedure TForm1.PopupListWndProc(var AMsg: TMessage);
function FindItemForCommand(APopupMenu: TPopupMenu;
const AMenuMsg: TWMMenuSelect): TMenuItem;
var
SubMenu: HMENU;
begin
Assert(APopupMenu <> nil);
// menuitem
Result := APopupMenu.FindItem(AMenuMsg.IDItem, fkCommand);
if Result = nil then begin
// submenu
SubMenu := GetSubMenu(AMenuMsg.Menu, AMenuMsg.IDItem);
if SubMenu <> 0 then
Result := APopupMenu.FindItem(SubMenu, fkHandle);
end;
end;
var
Msg: TWMMenuSelect;
menuItem: TMenuItem;
MenuIndex: integer;
begin
AMsg.Result := CallWindowProc(fOldWndProc, Menus.PopupList.Window,
AMsg.Msg, AMsg.WParam, AMsg.LParam);
if AMsg.Msg = WM_MENUSELECT then begin
menuItem := nil;
Msg := TWMMenuSelect(AMsg);
if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then begin
for MenuIndex := 0 to PopupList.Count - 1 do begin
menuItem := FindItemForCommand(PopupList.Items[MenuIndex], Msg);
if menuItem <> nil then
break;
end;
end;
miHint.DoActivateHint(menuItem);
end;
end;
This is done for all popup menus in a loop, until the first matching item or submenu is found.
Not sure if it helps, but I have created my own multi-line hint window (for Delphi7) to be able to show more then just one line of text.
It's open source and you can find it here.
There is some work involved showing it on the right location on the screen, but you have full control over it.

Resources