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.
Related
I still can't figure out how to get rid of warnings about uninitialized variables whenever I use the following structure, even though I know that this can never happen.
TCustomEnum = (ceValue1, ceValue2, ceValue3);
function DoSomething(LI_Enum: TCustomEnum): Integer;
var
lNumber : Integer;
begin
case LI_Enum of
ceValue1 : lNumber := 1;
ceValue2 : lNumber := 2;
ceValue3 : lNumber := 3;
end;
Result := 2 * lNumber;
end;
W1036 Variable 'lNumber' might not have been initialized
I found 3 solutions, but i don't like any of them. Especially with more variables or statements. Is there any other way how to avoid this?
Wrap function with {$WARN USE_BEFORE_DEF OFF} and {$WARN USE_BEFORE_DEF ON}
In every case statement use else Exit; with Result := 0 on the beginning
Initialize every variable although the value will be never used
By doing something like the following
function DoSomething(LI_Enum: TCustomEnum): Integer;
var
lNumber : Integer;
begin
case LI_Enum of
ceValue1 : lNumber := 1;
ceValue2 : lNumber := 2;
ceValue3 : lNumber := 3;
else raise exception.create('Oops I forgot one of the LI_Enum values')
end;
Result := 2 * lNumber;
end;
Perhaps a better exception text or even not raising an exception at all (and assigning a different value to lNumber), but raising an exception does have the benefit of prompting you if, say, six months down the line you add a new case value.
Edit
The point really is that the compiler is correct. The underlying structure for an enum is some form of (unsigned) integer so it is perfectly possible for the enum to contain an illegal value, say 27, for example. There are lots of ways this can arise in practice. So you need to cater for that possibility if you are writing complete code. The compiler is just warning you that you have not catered for that possibility.
I find this compiler warning a little disappointing. After all, surely the compiler can detect that you have covered all possible values of the enumerated type. I don't believe that it should be worrying about you having put an invalid ordinal in the enumerated type, if indeed that is the thinking behind this warning.
In any case, I personally use the following helper methods to deal with this:
procedure RaiseAssertionFailed; overload;
procedure RaiseAssertionFailed(var v1); overload;
procedure RaiseAssertionFailed(var v1,v2); overload;
....
procedure DoRaiseAssertionFailed;
begin
raise EAssertionFailed.CreateFmt(
'A critical error has occurred:'+ sLineBreak + sLineBreak +
' Assertion failed at %p.'+ sLineBreak + sLineBreak +
'In order to avoid invalid results or data corruption please close the program and report '+
'the above error code along with any other information relating to this problem.',
[ReturnAddress]
) at ReturnAddress;
end;
procedure RaiseAssertionFailed;
asm
JMP DoRaiseAssertionFailed;
end;
procedure RaiseAssertionFailed(var v1);
asm
JMP DoRaiseAssertionFailed;
end;
procedure RaiseAssertionFailed(var v1,v2);
asm
JMP DoRaiseAssertionFailed;
end;
Your code would then become:
function DoSomething(LI_Enum: TCustomEnum): Integer;
var
lNumber : Integer;
begin
case LI_Enum of
ceValue1 : lNumber := 1;
ceValue2 : lNumber := 2;
ceValue3 : lNumber := 3;
else
RaiseAssertionFailed(lNumber);
end;
Result := 2 * lNumber;
end;
This is very similar to the approach outlined by #Dsm. If you use that approach then compiler can see that you are raising an exception, and knows that lNumber does not need to be initialized.
I prefer though to wrap the raising of the exception into a shared function. That way I don't need to write the same error message again and again. An application of the DRY principle.
However, if you do this, and move the raise into a shared function, then the compiler is not capable of determining that the function will raise an exception. Hence the untyped var parameters. This allows you to mark the variable as being potentially modified and so suppress the compiler warning.
Yet another approach would be to declare an exception class that supplied the text in its parameterless constructor.
type
EInternalError = class(Exception)
public
constructor Create;
end;
constructor EInternalError.Create;
begin
inherited Create(
'...' // your text goes here
);
end;
Then your code becomes:
function DoSomething(LI_Enum: TCustomEnum): Integer;
var
lNumber : Integer;
begin
case LI_Enum of
ceValue1 : lNumber := 1;
ceValue2 : lNumber := 2;
ceValue3 : lNumber := 3;
else
raise EInternalError.Create;
end;
Result := 2 * lNumber;
end;
From a DWScript script, I call a method of an object instance exposed by the Delphi side. The method takes, among others, an argument which is a set of some enumerated data type. This enumerated datatype is exposed from Delphi to the script.
I saw from the error message generated at script compile time that DWScript pass such an argument as an array of integer and that the Delphi side receive an array of variant (TData).
I had to write a wrapper at Delphi side which loops thru the array and rebuild the corresponding set-of variable to pass it to the actual Delphi function. Accessing the array is done using "ProgramInfo.Vars['MsgFlags'].GetData".
This works perfectly well, but is this the correct may to do? Did I miss something?
Script side code:
procedure Test;
begin
DelphiObject.Demo('Hello', [mffStop, mffClose]);
end;
Delphi side code:
TFlag = (mmfStop, mffStart, mmfClose);
TFlags = set of TFlag;
// Internal method doing the actual job
procedure TDelphiObject.DemoInternal(
const MsgText : String;
const MsgFlags : TFlags);
begin
// Some code...
end;
// Wrapper method exposed to script
procedure TDelphiObject.Demo(
const MsgText : String;
const MsgFlags : array of integer);
var
Flags : TFlags;
I : Integer;
begin
Flags := [];
for I := Low(MsgFlags) to High(MsgFlags) do
Flags := Flags + [TFlag(MsgFlags[I])];
DemoInternal(MsgText, Flags);
end;
I would implement the Delphi side a bit differently (see below), but apart from that your solution appears correct.
The quirk, as you've correctly observed, is that DWScript represents static sets as arrays. Note however that this is just a limitation of the compiler frontend which hopefully, someday, will be resolved. See DWScript issue #10: Improve implicit casts from static arrays to sets.
The following script demonstrates in which cases the compiler performs an implicit cast between set and array:
type
TMyEnum = (meOne, meTwo);
type
TMySet = set of TMyEnum;
type
TMyArray = array of TMyEnum;
procedure TestSet(MySet: TMySet);
begin
ShowMessage(integer(MySet).toString);
end;
procedure TestArray(MyArray: TMyArray);
var
MySet: TMySet;
begin
MySet := [];
for var i := 0 to MyArray.Length-1 do
Include(MySet, MyArray[i]);
ShowMessage(integer(MySet).toString);
end;
begin
TestSet([]);
TestArray([]);
TestSet([meOne]);
TestArray([meOne]);
TestSet([meOne, meTwo]);
TestArray([meOne, meTwo]);
var VarSet: TMySet = [meOne, meTwo];
TestSet(VarSet);
// Syntax Error: Argument 0 expects type "array of TMyEnum" instead of "TMySet"
// TestArray(VarSet);
var VarArray: TMyArray = [meOne, meTwo];
TestArray(VarArray);
// Syntax Error: Argument 0 expects type "array of TMyEnum" instead of "TMySet"
// TestArray(VarSet);
// Syntax Error: Incompatible types: "TMySet" and "array [0..1] of TMyEnum" const ConstSet: TMySet = [meOne, meTwo];
// const ConstSet: TMySet = [meOne, meTwo];
// TestSet(ConstSet);
// TestArray(ConstSet);
// Syntax Error: Incompatible types: "array of TMyEnum" and "array [0..1] of TMyEnum"
// const ConstArray: TMyArray = [meOne, meTwo];
// TestSet(ConstArray);
// TestArray(ConstArray);
end;
The above is purely a script side implementation. When you add a Delphi side implementation into the mix it can get problematic.
Consider a simplified implementation of the MessageDlg function:
Delphi side declaration (via TdwsUnit):
type
TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, etc...);
TMsgDlgButtons = set of TMsgDlgBtn;
function MessageDlg(const Msg: string; Buttons: TMsgDlgButtons): integer;
Delphi side implementation:
Info.ResultAsInteger := MessageDlg(Info.ParamAsString[0], mtInformation, TMsgDlgButtons(Word(Info.ParamAsInteger[1])), -1);
Script side usage:
begin
// Implicit cast from array to set fails:
// Syntax Error: There is no overloaded version of "MessageDlg" that can be called with these arguments
// MessageDlg('Test', [mbOK]);
var Buttons: TMsgDlgButtons = [mbOK];
MessageDlg('Test', Buttons);
end;
Now lets try the same with your solution declaring the set parameter as an array instead:
Delphi side declaration (via TdwsUnit):
type
TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, etc...);
TMsgDlgButtons = array of TMsgDlgBtn;
function MessageDlg(const Msg: string; Buttons: TMsgDlgButtons): integer;
Delphi side implementation:
var
Buttons: TMsgDlgButtons;
i: integer;
ButtonArray: IScriptDynArray;
begin
ButtonArray := Info.Params[1].ScriptDynArray;
Buttons := [];
for i := 0 to ButtonArray.ArrayLength-1 do
Include(Buttons, TMsgDlgBtn(ButtonArray.AsInteger[i]));
Info.ResultAsInteger := MessageDlgEx(Info.ParamAsString[0], mtInformation, Buttons, -1);
end;
Script side usage:
begin
MessageDlg('Test', [mbOK]);
var Buttons: TMsgDlgButtons = [mbOK];
// Note that an implicit cast from set to array is performed
MessageDlg('Test', Buttons);
end;
In my own branch of DWScript I've modified the compiler to perform an implicit cast from an array of enum values to a set: DWScript pull request #4: Enhancement to set type. This works beautifully and resolves all the cases above that otherwise fail.
I have 2 applications- Manager with this code:
procedure TForm1.CopyData(var Msg: TWMCopyData);
var sMsg: String;
begin
if IsIconic(Application.Handle) then Application.Restore;
sMsg := PWideChar(Msg.CopyDataStruct.lpData);
Caption := Caption+'#'+sMsg;
Msg.Result := 123;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
WM_MY_MESSAGE = WM_USER + 1;
var
h: HWND;
begin
Caption := 'X';
h := FindWindow('TForm1', 'Client');
if not IsWindow(h) then Exit;
Caption := Caption+'#';
SendMessage(h, WM_MY_MESSAGE, 123, 321);
end;
And Client with:
procedure TForm1.WndProc(var Message: TMessage);
const
WM_MY_MESSAGE = WM_USER + 1;
var DataStruct: CopyDataStruct;
S: String;
h: HWND;
begin
inherited;
if Message.Msg <> WM_MY_MESSAGE then Exit;
h := FindWindow('TForm1', 'Manager');
if not IsWindow(h) then Exit;
Message.Result := 123;
S := Edit2.Text + '#' + Edit1.Text;
DataStruct.dwData := 0;
DataStruct.cbData := 2*Length(S)+1;
DataStruct.lpData := PWideChar(S);
Caption := Caption + '#';
PostMessage(h, WM_CopyData, Form1.handle, integer(#DataStruct));
end;
The code works- but only once.
Manager sends 2 integers: 123 and 321 as a "wake up" message to the Client.
Client responds by sending contents of Edit1 + Edit2.
Then Manager gets this data and shows on its caption.
Why does it work only once? After I click Button1 again it does nothing.
As noted in comments, you must use SendMessage with WM_COPYDATA. The primary reason for this is that the message sender is responsible for cleaning up the resources used for the transfer. As noted in the documentation :
The receiving application should consider the data read-only. The lParam parameter is valid only during the processing of the message. The receiving application should not free the memory referenced by lParam. If the receiving application must access the data after SendMessage returns, it must copy the data into a local buffer.
The only way this can work is if the message sender waits for the receiver to process the message and return a result. Otherwise the sender cannot know when it is safe to release those resources.
PostMessage is asynchronous and returns immediately so this is simply not viable. SendMessage will block until the receiver processes the message and assigns a return value.
Here you are passing a pointer to a stack allocated (local variable) record #DataStruct. Further, you are also passing a pointer to a string which is a local variable. If you use PostMessage, this method will return immediately - the stack locations (for value types like the record) will become invalid and susceptible to being overwritten. The string lives on the heap but is reference counted and, in this case, will be freed when the method returns.
The solution is to always be sure to use SendMessage with WM_COPYDATA.
I need to get a name of a component (TButton), that is being assigned in design-time and is seen in Object Inspector (such as Button1Click at Button1.OnClick event on events tab).
I use now TypInfo unit to get method's information via PPropInfo and I get OnClick and TNotifyEvent strings as values, but I didn't get the Button1Click as string value.
How can I get it?
string := MethodName(GetMethodProp(Button1, 'OnClick').Code);
Note that the method needs to be 'published'.
If the property and assigned method are both published, you can use this:
uses
TypInfo;
function GetEventHandlerName(Obj: TObject; const EventName: String): String;
var
m: TMethod;
begin
m := GetMethodProp(Obj, EventName);
if (m.Data <> nil) and (m.Code <> nil) then
Result := TObject(m.Data).MethodName(m.Code)
else
Result := '';
end;
s := GetEventHandlerName(Button1, 'OnClick');
The TypInfo unit (where GetMethodProp() comes from) only supports published properties.
You have to specify the object that owns the method address because TObject.MethodName() iterates the object's VMT. And the method must be published because TObject.MethodName() (which exists to facilitate DFM streaming) iterates a portion of the VMT that is filled only with the addresses of published methods.
If you are using Delphi 2010 or later, you can use Extended RTTI instead, which does not have the published limitations:
uses
Rtti;
function GetEventHandlerName(Obj: TObject; const EventName: String): String;
type
PMethod = ^TMethod;
var
ctx: TRttiContext;
v: TValue;
_type: TRttiType;
m: TMethod;
method: TRttiMethod;
s: string;
begin
Result := '';
ctx := TRttiContext.Create;
v := ctx.GetType(Obj.ClassType).GetProperty(EventName).GetValue(Obj);
if (v.Kind = tkMethod) and (not v.IsEmpty) then
begin
// v.AsType<TMethod>() raises an EInvalidCast exception
// and v.AsType<TNotifyEvent>() is not generic enough
// to handle any kind of event. Basically, the Generic
// parameter of AsType<T> must match the actual type
// that the event is declared as. You can use
// TValue.GetReferenceToRawData() to get a pointer to
// the underlying TMethod data...
m := PMethod(v.GetReferenceToRawData())^;
_type := ctx.GetType(TObject(m.Data).ClassType);
for method in _type.GetMethods do
begin
if method.CodeAddress = m.Code then
begin
Result := method.Name;
Exit;
end;
end;
end;
s := GetEventHandlerName(Button1, 'OnClick');
I have a COM object written in Delphi that has a property that returns a variant. Basically this property returns a value depending on the parameter I pass it. When I access the object from VBA (Excel for example), I can write something like :
MyObject.MyProperty("IntProperty") = 22
Now the property can also return an IDispatch object, which is stored in the variant. If I access the com object from Delphi, I write the following code to extract that IDispatch information
var
Info : IMyInterface;
Info := IDispatch(TVarData(MyObject.MyProperty['InfoProperty']).VDispatch) as IMyInterface;
Info.foo := 10;
info.y := 'test';
info.saveit;
Is it possible to extract that IDispatch information in VBA? I haven't figured out a way to do it yet.
To be 100% clear, the property is of type OLEVariant, and not IDispatch. I have properties that are of type IDispatch, and they work fine.
This is the declaration of get_MethodProperty
function get_MethodProperty(const aPropertyName: WideString):OLEVariant;
It would work if I declared it as
function get_MethodProperty(const aPropertyName: WideString):IDispatch;
But that is not what I want.
This is the VBA code, and it fails on the second line
Dim Info as Object
Set Info = MyObject.MethodProperty("InfoProperty")
Info.foo = 10
Info.y = "test"
call info.saveit
I'm not quite sure what you mean by "extract the IDispatch information". VBA should be able to use a variant containing an IDispatch just fine. Simple tests include:
If you call info.xxx from vba, does xxx show up in your GetIDsOfNames?
If you call VarType(info) from vba, is the result vbObject? (== varDispatch)
You can "extract" IDispatch in VBA like this
Dim info As Object
Set info = MyObject.MyProperty("IntProperty")
info.foo = 10
info.y = "test"
info.saveit
As far as I know if IDispatch is involved you are using late-binding and therefore I think something like
Set info = CreateObject('WhatEverYourLibraryIs')
is missing
(maybe this microsoft link about Using early binding and late binding in Automation will help too)
I tried it in one of my automation servers and it worked fine in VBA (Excel). My implemetation in Delphi looks like this:
Get method in the main object:
function TApplication.Get_MethodProperty(const aPropertyName: WideString): OleVariant;
begin
if aPropertyName = 'IntProperty' then begin
result := 42;
end else if aPropertyName = 'InfoProperty' then begin
result := TInfoObject.Create as IDispatch;
end;
end;
The TInfoObject declaration:
TInfoObject = class(TAutoObject, IInfoObject)
protected
function Get_foo: Integer; safecall;
procedure Set_foo(Value: Integer); safecall;
function Get_y: WideString; safecall;
procedure Set_y(const Value: WideString); safecall;
procedure saveit; safecall;
end;
The TInfoObject implmentation:
{ TInfoObject }
function TInfoObject.Get_foo: Integer;
begin
result := 123;
end;
function TInfoObject.Get_y: WideString;
begin
result := 'info';
end;
procedure TInfoObject.Set_foo(Value: Integer);
begin
// NYI
end;
procedure TInfoObject.Set_y(const Value: WideString);
begin
// NYI
end;
procedure TInfoObject.saveit;
begin
ShowMessage('saveit');
end;
The VBA test code:
Dim Info As Object
Set Info = MyObject.MethodProperty("InfoProperty")
Info.foo = 10
Info.y = "test"
Call Info.saveit
If this doesn't work in your app can you please provide me with your VBA error message.