Create an application with two forms, where the main form is created automatically, and the second form is created as needed. I've defined a custom message to pass a certain parameter from the secondary form (which is displayed in a non-modal way) to the main form, where I've defined a handler for this message. After sending the message, the secondary form is closed (and the closing action is set to Free).
The problem, that when I used PostMessage to send the message, the main form is minimized in response, and the action I defined in the message handler was not called (that is, the message was not displayed with the selected action). When I used SendMessage, the message was indeed read and processed, but the secondary form was closed only after closing the message box (as expected...).
What can I do to send the message and return immediately (so that the secondary form closes immediately) but not cause the primary form to minimize?
Here is the code I use:
MainFormUnit.pas
unit MainFormUnit;
...
const
SM_MY_MESSAGE = WM_USER + 1;
type TMyAction = (ma0, ma1);
type
TMainForm = class(TForm)
...
procedure DoMyAction(Action: TMyAction);
procedure SMMYMESSAGE(var Msg: TMessage); message SM_MY_MESSAGE;
procedure ShowChildForm;
...
end;
var
MainForm: TMainForm;
implementation
uses
ChildFormUnit;
...
procedure TMainForm.SMMYMESSAGE(var Msg: TMessage);
begin
DoMyAction(TMyAction(Msg.WParam));
end;
procedure TMainForm.DoMyAction(Action: TMyAction);
begin
ShowMessage(Format('The selected action is: %d', [Ord(Action)]));
end;
procedure TMainForm.ShowChildForm;
var
ChildForm: TChildForm;
begin
ChildForm := TChildForm.Create(Self);
ChildForm.Show;
end;
ChildFormUnit.pas
unit ChildFormUnit;
...
const SM_MY_MESSAGE = WM_USER + 1;
type
TChildForm = class(TForm)
...
procedure SendActionToMain(ActionNum: Integer);
procedure ChildFormClose(Sender: TObject; var Action: TCloseAction);
...
end;
implementation
uses MainFormUnit;
...
procedure TChildForm.SendActionToMain(ActionNum: Integer);
begin
PostMessage(MainForm.Handle, SM_MY_MESSAGE, ActionNum, 0);
close;
end;
...
procedure TChildForm.ChildFormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
Edit:
When I added in the SMMYMESSAGE handler additional code for processing (in my case it was ShowMessage(Format('The WParam is: %d', [Msg.WParam]));) before calling DoMyAction, the main form is minimized, the message "The WParam is.. .” did not appear, but the message specified in DoMyAction did appear! I really don't understand what is going on here??? PostMessage does send the message and it is received by the handler, and things happen that I didn't want!
Related
In Embarcadero Delphi XE7, I use a component which has a help-button.
In the component (which shows a message dialog), I specify a help context number. If the user clicks on the button, the help should show, but I get an error instead:
Project ... raised exception class $C00000FD with message 'stack overflow at 0x006f089e'.
The command executed when the user clicks on the button is:
Application.HelpContext(HelpContextNumber);
On Launch HTML Help as Separate Process, I read that I should attach an OnHelp event handler to the Application object.
I saved the Help unit but how do I attach it?
Application.OnHelp := ....?
The TApplication.OnHelp event is declared as a THelpEvent:
THelpEvent = function(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean of object;
So, you would need to declare a method in your Form like this:
type
TMyForm = class(TForm)
...
private
function MyOnHelpHandler(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
...
end;
And then you can assign that handler to the TApplication.OnHelp event at runtime, eg:
procedure TMyForm.FormCreate(Sender: TObject);
begin
Application.OnHelp := MyOnHelpHandler;
end;
procedure TMyForm.FormDestroy(Sender: TObject);
begin
Application.OnHelp := nil;
end;
function TMyForm.MyOnHelpHandler(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
begin
Result := ...;
end;
Alternatively, you can drop a TApplicationEvents component onto your Form at design-time, and then create an OnHelp event handler for it using the Object Inspector.
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;
Delphi Tokyo - I am wanting to send a record structure between forms via Windows Messages. Specifically, I have a "display running status" type of window. When behaviors occur elsewhere in my application, I need to send an "update the status window" type of message. I have found an example which passes a record via windows messages (but only within the same process), but am having issues making it work. Specifically, on the receiving side, I am having trouble compiling the windows message handler code. I have an 'Incompatible Type' error, but I can't figure out how to typecast to get it working. Here are the applicable code snippets.
In a globals.pas unit, which all forms access.
// Define my message
const WM_BATCHDISPLAY_MESSAGE = WM_USER + $0001;
...
// Define the record which is basically the message payload
type
TWMUCommand = record
Min: Integer;
Max: Integer;
Avg: Integer;
bOverBudget: Boolean;
Param1: Integer;
Param2: String;
end;
...
// define a global variable
PWMUCommand : ^TWMUCommand;
Now for the sending of the message. This is currently just a button in order to test.
procedure TMainForm.BitBtn1Click(Sender: TObject);
var
msg_prm: ^TWMUCommand;
begin
New(msg_prm);
msg_prm.Min := 5;
msg_prm.Max := 10;
msg_prm.Avg := 7;
msg_prm.bOverBudget := True;
msg_prm.Param1 := 0;
msg_prm.Param2 := 'some string';
PostMessage(Handle, WM_BATCHDISPLAY_MESSAGE, 0, Integer(msg_prm));
end;
On the receiving form, aka my status form... declare my message listener
procedure MessageHandler(var Msg: TMessage); message WM_BATCHDISPLAY_MESSAGE;
Now define the message handler.
procedure TBatchForm.MessageHandler(var Msg: TMessage);
var
msg_prm: ^TWMUCommand;
begin
try
// Next line fails with Incompatible types
msg_prm := ^TWMUCommand(Msg.LParam);
ShowMessage(Format('min: %d; max: %d; avg: %d; ovrbdgt: %s; p1: %d; p2: %s',
[msg_prm.Min, msg_prm.Max, msg_prm.Avg, BoolToStr(msg_prm.bOverBudget, True),
msg_prm.Param1, msg_prm.Param2]));
finally
Dispose(msg_prm);
end;
end;
How do I cast Msg.LParam back into the record structure?
First of all, it's easier to declare a pointer type for the record:
type
PWMUCommand = ^TWMUCommand;
TWMUCommand = record
...
end;
Then in the method that posts the message, declare the pointer to be PWMUCommand.
Your Integer cast assumes 32 bit code. Better to cast to the true type of that argument which is LPARAM.
PostMessage(..., LPARAM(msg_prm));
In the function the receives the message, declare the local variable using the pointer type:
var
msg_prm: PWMUCommand;
Cast it like this:
msg_prm := PWMUCommand(Msg.LParam);
Note that when you call PostMessage you should check the return value in case of failure. If it fails, then you need to dispose of the memory then.
if not PostMessage(..., LPARAM(msg_prm)) then
begin
Dispose(msg_prm);
// handle error
end;
Finally, as I think that you are aware, this approach only works if the sender and receiver are in the same process.
I want to call a function after a form has been maxmized or restored.
I know I can something like this:
procedure TfrmMain.WMSysCommand;
begin
if (Msg.CmdType = SC_MAXIMIZE) OR (Msg.CmdType = SC_RESTORE) then
begin
Showmessage(IntToStr(frmMain.Height));
end;
DefaultHandler(Msg) ;
end;
But the problem is: this event is fired before the form is actually resized - so when the form is maximized, I get the height of the form BEFORE it was maxmized (but I want the width of the form after it has been maximized).
How to do this? Thanks!
the following link maybe will help you:
http://www.tek-tips.com/viewthread.cfm?qid=809465&page=176
declare this into interface section of this unit
Procedure sizeMove (var msg: TWMSize); message WM_SIZE;
and implementation of this procedure:
Procedure TfrmMain.sizeMove (var msg: TWMSize);
begin
inherited;
if (msg.SizeType = SIZE_MAXIMIZED) OR (msg.SizeType = SIZE_RESTORED)then
resizeQlikViewReports();
end;
You can use OnResize either and check WindowState. It's easier way.
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.