I need to send a windows message to a TDataModule in my Delphi 2010 app.
I would like to use
PostMessage(???.Handle, UM_LOG_ON_OFF, 0,0);
Question:
The TDataModule does not have a Handle. How can I send a windows message to it?
You can give it a handle easily enough. Take a look at AllocateHWND in the Classes unit. Call this to create a handle for your data module, and define a simple message handler that will process UM_LOG_ON_OFF.
Here is an example demonstrating how to create a TDataModule's descendant with an Handle
uses
Windows, Winapi.Messages,
System.SysUtils, System.Classes;
const
UM_TEST = WM_USER + 1;
type
TMyDataModule = class(TDataModule)
private
FHandle: HWND;
protected
procedure WndProc(var Message: TMessage); virtual;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy(); override;
property Handle : HWND read FHandle;
end;
...
uses
Vcl.Dialogs;
constructor TMyDataModule.Create(AOwner : TComponent);
begin
inherited;
FHandle := AllocateHWND(WndProc);
end;
destructor TMyDataModule.Destroy();
begin
DeallocateHWND(FHandle);
inherited;
end;
procedure TMyDataModule.WndProc(var Message: TMessage);
begin
if(Message.Msg = UM_TEST) then
begin
ShowMessage('Test');
end;
end;
Then we can send messages to the datamodule, like this:
procedure TForm1.Button1Click(Sender: TObject);
begin
PostMessage(MyDataModule.Handle, uMyDataModule.UM_TEST, 0, 0);
end;
Related
I'm trying to build a component based on FMX.Objects.TImage. I want the permanently assigned images by MultiResBitmap.Items to change without having to use OnMouseEnter and OnMouseLeave in the application. Of course, I will use the constructor and the destructor.
I'm a beginner, and maybe I don't understand something. I've been trying for a week now, and I can't detect the mouse over the component and assign events correctly to it. I temporarily used ShowMessage() for the test.
Theoretically, this code should probably work and not work. Tell me what I'm doing wrong.
unit ImageCustoms;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, FMX.Types, vcl.Controls, FMX.Objects, FMX.ImgList, vcl.Dialogs, vcl.Graphics, FMX.ExtCtrls;
type
TImageCostoms = class(TImage)
private
{ Private declarations }
FOnMouseLeave: TNotifyEvent;
FOnMouseEnter: TNotifyEvent;
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
{ Protected declarations }
procedure DoMouseEnter; virtual;
procedure DoMouseLeave; virtual;
public
{ Public declarations }
//constructor Create(AOwner: TComponent); override;
//destructor Destroy; override;
published
{ Published declarations }
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TImageCostoms]);
end;
procedure TImageCostoms.CMMouseEnter(var msg: TMessage);
begin
ShowMessage('Enter');
DoMouseEnter;
end;
procedure TImageCostoms.CMMouseLeave(var msg: TMessage);
begin
ShowMessage('Leave');
DoMouseLeave;
end;
procedure TImageCostoms.DoMouseEnter;
begin
if Assigned(FOnMouseEnter) then
ShowMessage('Enter');
FOnMouseEnter(Self);
end;
procedure TImageCostoms.DoMouseLeave;
begin
if Assigned(FOnMouseLeave) then
ShowMessage('Leave');
FOnMouseLeave(Self);
end;
{constructor TImageCostoms.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png'); // .\img\i.png
end;
destructor TImageCostoms.Destroy;
begin
inherited Destroy;
end; }
end.
First off, don't mix VCL and FMX units together in your own units. VCL and FMX are not designed to be used together. And since FMX is cross-platform, don't use Winapi units in your code unless you are writing Windows-specific code (which you are not, in this situation).
You don't need to handle the CM_MOUSE(ENTER|LEAVE) messages directly, the framework already does that internally for you. And you don't need to redeclare the OnMouse(Enter|Leave) events, they already exist and are published in TImage.
All you really need to do is override (not redeclare) the existing virtual DoMouse(Enter|Leave) methods from Timage, eg:
unit ImageCustoms;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Objects, FMX.ImgList, FMX.ExtCtrls;
type
TImageCostoms = class(TImage)
private
{ Private declarations }
protected
{ Protected declarations }
procedure DoMouseEnter; override;
procedure DoMouseLeave; override;
public
{ Public declarations }
//constructor Create(AOwner: TComponent); override;
//destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TImageCostoms]);
end;
procedure TImageCostoms.DoMouseEnter;
begin
...
inherited;
end;
procedure TImageCostoms.DoMouseLeave;
begin
...
inherited;
end;
{constructor TImageCostoms.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png'); // .\img\i.png
end;
destructor TImageCostoms.Destroy;
begin
inherited Destroy;
end; }
end.
Don't use ShowMessage() to debug component code, especially in events that react to keyboard/mouse focus changes. If you want to see debug messages, use OutputDebugString() or equivilent instead, and then look for the messages in the IDE's Output window. Or, just make display changes in your UI, like color changes, etc.
Thank you, it helped me, I was trying very uphill. In fact, in FMX it is simple and everything works. Thank you very much. I write the virtual keyboard support for the program, the whole is just a transparent button changing the focus slightly. Thanks again. For posterity, for now, it looks like this, I will try to add support from the global ImageList.
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Objects, FMX.ImgList, vcl.Dialogs, System.UITypes;
type
TImageCostoms = class(TImage)
private
{ Private declarations }
procedure DoMouseEnter; override;
procedure DoMouseLeave; override;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TImageCostoms]);
end;
procedure TImageCostoms.DoMouseEnter;
begin
inherited ;
MultiResBitmap.Items[1].Bitmap.LoadFromFile('focus1.png');
end;
procedure TImageCostoms.DoMouseLeave;
begin
inherited;
MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png');
end;
constructor TImageCostoms.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
width:=45;
height:=45;
MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png');
end;
end.```
I have written a Delphi component that has a property of type TStrings. All works well except that when the String List Editor is launched, the "Code Editor" button is disabled. Anyone know what I need to set to allow this?
Perhaps this is due to being called from the collection editor?
The entire component is is about 80 lines so I put it all here. It is a VCL component.
// Simple example of of creating a OwnedCollection of TStrings
unit TextStorageMin;
interface
uses
System.Classes, System.SysUtils, Winapi.Windows, System.Generics.Collections;
type
// Storage class to store TStrings
TStorageStrings = class(TCollectionItem)
private
FStrings: TStrings;
procedure SetStrings(const Value: TStrings);
public
published
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
// Why, when this is brought up in the Strings List Editor, is
// the "Code Editor" not enabled.
property Strings: TStrings read FStrings write SetStrings;
end;
// Just simple Owned Collection
TStorageList = class(TOwnedCollection);
// This our component.
TTextStorageMin = class(TComponent)
private
FStorageList: TStorageList;
public
published
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Items: TStorageList read FStorageList write FStorageList;
end;
procedure Register;
implementation
// Register it
procedure Register;
begin
RegisterComponents('CompDev', [TTextStorageMin]);
end;
{ TTextStorage }
constructor TTextStorageMin.Create(AOwner: TComponent);
begin
inherited;
FStorageList := TStorageList.Create(AOwner, TStorageStrings);
end;
destructor TTextStorageMin.Destroy;
begin
FStorageList.Free;
inherited;
end;
{ TStorageStrings }
constructor TStorageStrings.Create(Collection: TCollection);
begin
inherited;
FStrings := TStringList.Create;
end;
destructor TStorageStrings.Destroy;
begin
FStrings.Free;
inherited;
end;
procedure TStorageStrings.SetStrings(const Value: TStrings);
begin
FStrings.Assign(Value);
end;
Your main component is coded all wrong. It is completely mismanaging the ownership of the TStorageList object. It is assigning the wrong Owner to the object, and there is no property setter implementee to avoid a memory leak and taking ownership of an external object (in this case, one created and destroyed by the IDE at design-time).
Also, your TStorageStrings class is missing an overload of Assign() (or AssignTo()), which also plays into the above mismanagement.
The code should look more like this instead:
// Simple example of of creating a OwnedCollection of TStrings
unit TextStorageMin;
interface
uses
System.Classes;
type
// Storage class to store TStrings
TStorageStrings = class(TCollectionItem)
private
FStrings: TStrings;
procedure SetStrings(const Value: TStrings);
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(ASource: TPersistent); override;
published
property Strings: TStrings read FStrings write SetStrings;
end;
// Just simple Owned Collection
TStorageList = class(TOwnedCollection);
// This our component.
TTextStorageMin = class(TComponent)
private
FStorageList: TStorageList;
procedure SetItems(const Value: TStorageList);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Items: TStorageList read FStorageList write SetItems;
end;
procedure Register;
implementation
// Register it
procedure Register;
begin
RegisterComponents('CompDev', [TTextStorageMin]);
end;
{ TTextStorage }
constructor TTextStorageMin.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStorageList := TStorageList.Create(Self, TStorageStrings);
end;
destructor TTextStorageMin.Destroy;
begin
FStorageList.Free;
inherited;
end;
procedure TTextStorageMin.SetItems(const Value: TStorageList);
begin
FStorageList.Assign(Value);
end;
{ TStorageStrings }
constructor TStorageStrings.Create(Collection: TCollection);
begin
inherited Create(Collection);
FStrings := TStringList.Create;
end;
destructor TStorageStrings.Destroy;
begin
FStrings.Free;
inherited;
end;
procedure TStorageStrings.Assign(ASource: TPersistent);
begin
if ASource is TStorageStrings then
FStrings.Assign(TStorageStrings(ASource).Strings)
else
inherited;
end;
procedure TStorageStrings.SetStrings(const Value: TStrings);
begin
FStrings.Assign(Value);
end;
end.
I have made a data module and a button. When I send info to the data module it gives an access violation when the program is done even when nothing needs to be done. What is going wrong? I use Delphi XE on w8.1.
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
end;
Here is the data module unit:
interface
uses
System.SysUtils, System.Classes, classdef;
type
TmodMain = class(TDataModule)
private
{ Private declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Calc(ACake: TCake);
end;
var
modMain: TmodMain;
implementation
{%CLASSGROUP 'System.Classes.TPersistent'}
{$R *.dfm}
{ TmodMain }
procedure TmodMain.Calc(ACake: TCake);
begin
end;
constructor TmodMain.Create(AOwner: TComponent);
begin
inherited;
end;
destructor TmodMain.Destroy;
begin
inherited;
end;
end.
To clarify my class definitions unit I will post it here.
Here is my classdef unit:
unit classdef;
interface
type
TCake = class
private
FDiameter: Double;
public
property Diameter: Double read FDiameter write FDiameter;
end;
implementation
end.
The problem is that you need to create a class instance before you can use it.
In this example I assume that your datamodule has been autocreated by the IDE.
So your code:
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
end;
becomes:
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake := TCake.Create;
try
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
finally
ACake.Free;
end;
end;
I'm trying to create a VCL component, that lets you insert multiple TImages of different sizes as properties.
I was told to best use a TObjectList ( Delphi component with a variable amount of TPictures ), but now I'm struggling to make the single TPictures assignable in the Property editor.
What i have at the moment: (it compiles)
unit ImageMultiStates;
interface
uses
Vcl.Graphics, Vcl.StdCtrls, System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Forms, Generics.Collections;
type
TImageMultiStates = class(TImage)
private
FPictures: TObjectList<TPicture>;
procedure SetPicture(Which: Integer; APicture: TPicture);
function GetPicture(Which: Integer): TPicture;
public
Count: integer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Activate(Which: Integer);
published
// property Pictures: TObjectList<TPicture> read GetPicture write SetPicture;
// property Pictures[Index: Integer]: TObjectList<TPicture> read GetPicture write SetPicture;
property Pictures: TObjectList<TPicture> read FPictures write FPictures;
end;
procedure Register;
implementation
constructor TImageMultiStates.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPictures := TObjectList<TPicture>.Create;
end;
destructor TImageMultiStates.Destroy;
begin
FPictures.Free;
inherited Destroy;
end;
procedure TImageMultiStates.SetPicture(Which: Integer; APicture: TPicture);
begin
FPictures[Which] := APicture;
if Which=0 then
Picture.Assign(APicture);
end;
function TImageMultiStates.GetPicture(Which: Integer): TPicture;
begin
Result := FPictures[Which];
end;
procedure TImageMultiStates.Activate(Which: Integer);
begin
Picture.Assign(FPictures[Which]);
end;
procedure Register;
begin
RegisterComponents('Standard', [TImageMultiStates]);
end;
end.
What doesn't work is the final result in the PropertyEditor. It shows one single item named "Pictures", with the value "(TObjectList)". Clicking it doesn't do anything, i don't get a proper editor. Other ideas for the line in question have been commented out, they bring other errors:
The first one throws the compiler error "E2008 Incompatible Types", The second one throws "Published property 'Pictures' can not be of type ARRAY".
The IDE has no idea how to edit a TObjectList at design-time, and the DFM streaming system has no idea how to stream a TObjectList. You would have to implement a custom property editor and custom streaming logic. While that is certainly possible, it is a LOT of work.
What you are attempting to do is better handled by using System.Classes.TCollection instead. Both the IDE and the DFM streaming system have built-in support for handling TCollection editing and streaming automatically for you.
Try something more like this:
unit ImageMultiStates;
interface
uses
System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Graphics;
type
TImagePictureItem = class(TCollectionItem)
private
FPicture: TPicture;
procedure PictureChanged(Sender: TObject);
procedure SetPicture(Value: TPicture);
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property Picture: TPicture read FPicture write SetPicture;
end;
TImagePictureEvent = procedure(Sender: TObject; Index: Integer) of object;
TImagePictures = class(TOwnedCollection)
private
FOnPictureChange: TImagePictureEvent;
function GetPicture(Index: Integer): TImagePictureItem;
procedure SetPicture(Index: Integer; Value: TImagePictureItem);
protected
procedure Update(Item: TCollectionItem); override;
public
constructor Create(Owner: TComponent); reintroduce;
property Pictures[Index: Integer]: TImagePictureItem read GetPicture write SetPicture; default;
property OnPictureChange: TImagePictureEvent read FOnPictureChange write FOnPictureChange;
end;
TImageMultiStates = class(TImage)
private
FActivePicture: Integer;
FPictures: TImagePictures;
function GetPicture(Index: Integer): TPicture;
procedure PictureChanged(Sender: TObject; Index: Integer);
procedure SetActivePicture(Index: Integer);
procedure SetPicture(Index: Integer; Value: TPicture);
procedure SetPictures(Value: TImagePictures);
protected
procedure Loaded; override;
public
constructor Create(Owner: TComponent); override;
function Count: integer;
property Pictures[Index: Integer]: TPicture read GetPicture write SetPicture;
published
property ActivePicture: Integer read FActivePicture write SetActivePicture default -1;
property Picture stored False;
property Pictures: TImagePictures read FPictures write SetPictures;
end;
procedure Register;
implementation
{ TImagePictureItem }
constructor TImagePictureItem.Create(Collection: TCollection);
begin
inherited Create(Collection);
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
end;
destructor TImagePictureItem.Destroy;
begin
FPicture.Free;
inherited;
end;
procedure TImagePictureItem.PictureChanged(Sender: TObject);
begin
Changed(False);
end;
procedure TImagePictureItem.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;
{ TImagePictures }
constructor TImagePictures.Create(Owner: TComponent);
begin
inherited Create(Owner, TImagePictureItem);
end;
function TImagePictures.GetPicture(Index: Integer): TImagePictureItem;
begin
Result := TImagePictureItem(inherited GetItem(Index));
end;
procedure TImagePictures.SetPicture(Index: Integer; Value: TImagePictureItem);
begin
inherited SetItem(Index, Value);
end;
procedure TImagePictures.Update(Item: TCollectionItem);
begin
if Assigned(FOnPictureChange) then
begin
if Item <> nil then
FOnPictureChange(Self, Item.Index)
else
FOnPictureChange(Self, -1);
end;
end;
{ TImageMultiStates }
constructor TImageMultiStates.Create(Owner: TComponent);
begin
inherited Create(Owner);
FPictures := TImagePictures.Create(Self);
FPictures.OnPictureChange := PictureChanged;
FActivePicture := -1;
end;
procedure TImageMultiStates.Loaded;
begin
inherited;
PictureChanged(nil, FActivePicture);
end;
function TImageMultiStates.Count: Integer;
begin
Result := FPictures.Count;
end;
procedure TImageMultiStates.PictureChanged(Sender: TObject; Index: Integer);
begin
if (FActivePicture <> -1) and ((Index = -1) or (Index = FActivePicture)) then
Picture.Assign(GetPicture(FActivePicture));
end;
function TImageMultiStates.GetPicture(Index: Integer): TPicture;
begin
Result := FPictures[Index].Picture;
end;
procedure TImageMultiStates.SetPicture(Index: Integer; Value: TPicture);
begin
FPictures[Index].Picture.Assign(Value);
end;
procedure TImageMultiStates.SetActivatePicture(Value: Integer);
begin
if FActivePicture <> Value then
begin
if ComponentState * [csLoading, csReading] = [] then
Picture.Assign(GetPicture(Value));
FActivePicture := Value;
end;
end;
procedure Register;
begin
RegisterComponents('Standard', [TImageMultiStates]);
// the inherited TImage.Picture property is published, and you cannot
// decrease the visibility of an existing property. However, if you move
// this procedure into a separate design-time package, you can then use
// DesignIntf.UnlistPublishedProperty() to hide the inherited
// Picture property at design-time, at least:
//
// UnlistPublishedProperty(TImageMultiStates, 'Picture');
//
// Thus, users are forced to use the TImageMultiStates.Pictures and
// TImageMultiStates.ActivePicture at design-time. The inherited
// Picture property will still be accessible in code at runtime, though...
end;
end.
I want to write a TCheckBox and TRadioButton descendants having 3 identical methods.
TMyCheckBox = class(TCheckBox)
procedure DoSomething1;
procedure DoSomething2;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
end;
TMyRadioButton = class(TRadioButton)
procedure DoSomething1;
procedure DoSomething2;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
end;
// the following procedures are common for both classes, so in fact
// TMyCheckBox.DoSomething1 do the same as TMyRadioButton.DoSomething1
procedure DoSomething1;
begin
// here is the same code for TMyCheckBox as well as for TMyRadioButton
// but I don't want to write the same code many times but implement it
// for both classes at once in some common way
end;
procedure DoSomething2;
begin
// here is the same code for TMyCheckBox as well as for TMyRadioButton
// but I don't want to write the same code many times but implement it
// for both classes at once in some common way
end;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
begin
// here is the same code for TMyCheckBox as well as for TMyRadioButton
// but I don't want to write the same code many times but implement it
// for both classes at once in some common way
end;
How can I do this?
Define an interface say IDoSomething with the the three method signatures.
Then change your class declaration to
TMyCheckBox = class(TCheckBox, IDoSomething)
and then implement.
If the implementations are common or very close.
Then define a helper class TDoSomething and then delegate the work.
e.g.
Procedure TMyCheckBox.DoSomething1; // implements IDoSomething1
Begin
TDoSomething.DoSomething1(Self); // given class method will suffice.
End;
Class Methods in delphi, equivalent to static methods in other languages.
Type
TDoSomethingHelper = Class(TObject)
Public
Class Procedure DoSomething1(aComponent : TComponent);
End;
...
implementation
Class Procedure TDoSomethingHelper.DoSomething1(aComponent : TComponent);
Begin
aComponent.Tag = 27;
End;
You are looking for implementation inheritance rather than interface inheritance. This is only achievable in Delphi if you can derive classes from a single common ancestor. This limitation is inherent because the language only supports single-inheritance.
The best you can do is something like this:
type
TMyWinControlExtender = class
private
FTarget: TWinControl;
public
constructor Create(Target: TWinControl);
procedure WMSize(var Message: TWMSize; out CallInherited: Boolean);
procedure DoSomething;
end;
TMyCheckBox = class(TCheckBox)
private
FExtender: TMyWinControlExtender;
protected
procedure WMSize(var Message: TWMSize); message WM_SIZE;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DoSomething;
end;
TMyRadioButton = class(TRadioButton)
private
FExtender: TMyWinControlExtender;
protected
procedure WMSize(var Message: TWMSize); message WM_SIZE;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DoSomething;
end;
{ TMyWinControlExtender }
constructor TMyWinControlExtender.Create(Target: TWinControl);
begin
inherited Create;
FTarget := Target;
end;
procedure TMyWinControlExtender.WMSize(var Message: TWMSize; out CallInherited: Boolean);
begin
if FTarget.... then
....
CallInherited := ...;
//etc.
end;
procedure TMyWinControlExtender.DoSomething;
begin
if FTarget.... then
....
//etc.
end;
{ TMyCheckBox }
constructor TMyCheckBox.Create(AOwner: TComponent);
begin
inherited;
FExtender := TMyWinControlExtender.Create(Self);
end;
destructor TMyCheckBox.Destroy;
begin
FExtender.Free;
inherited;
end;
procedure TMyCheckBox.DoSomething;
begin
FExtender.DoSomething;
end;
procedure TMyCheckBox.WMSize(var Message: TWMSize);
var
CallInherited: Boolean;
begin
FExtender.WMSize(Message, CallInherited);
if CallInherited then
inherited;
end;
And likewise for TMyRadioButton etc.
Now, you could use interfaces and delegation to reduce some of the boilerplate, but there's no way for that to help with a message handler like WMSize.