How to load custom cursor in Firemonkey? - delphi

I need to use custom cursor in my Firemonkey desktop project.
I can use LoadCursorFromFile in VCL project to load a custom cursor in my project.
I have tried to do the same for Firemonkey but it is not loading the cursor.
Is there any working way to achieve loading custom cursors in Firemonkey?
uses Winapi.Windows;
procedure Tform1.Button1Click(Sender: TObject);
const mycursor= 1;
begin
Screen.Cursors[mycursor] := LoadCursorFromFile('C:\...\Arrow.cur');
Button1.Cursor := mycursor;
end;

I only did this for the Mac, but the general idea is that you implement your own IFMXCursorService. Keep in mind that this pretty much an all or nothing approach. You'll have to implement the default FMX cursors, too.
type
TWinCursorService = class(TInterfacedObject, IFMXCursorService)
private
class var FWinCursorService: TWinCursorService;
public
class constructor Create;
procedure SetCursor(const ACursor: TCursor);
function GetCursor: TCursor;
end;
{ TWinCursorService }
class constructor TWinCursorService.Create;
begin
FWinCursorService := TWinCursorService.Create;
TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
end;
function TWinCursorService.GetCursor: TCursor;
begin
// to be implemented
end;
procedure TWinCursorService.SetCursor(const ACursor: TCursor);
begin
Windows.SetCursor(Cursors[ACursor]); // you need to manage the Cursors list that contains the handles for all cursors
end;
It might be a necessary to add a flag to the TWinCursorService so that it will prevent the FMX framework to override your cursor.
Timing is important when registering your own cursor service. It will have to be done after FMX calls TPlatformServices.Current.AddPlatformService(IFMXCursorService, PlatformCocoa);

Unfortunately, FireMonkey does not support custom cursors. This has already been filed as a feature request in Quality Portal:
RSP-17651 Cannot load custom cursors in Firemonkey.
With that said, the code you showed would not work in VCL. LoadCursorFromFile() returns an HCURSOR handle, but the TControl.Cursor property expects an index value from the TCursor enum instead. They are not the same thing. When loading a custom cursor, you must add it to the TScreen.Cursors[] list. This is clearly stated in the documentation:
Vcl.Controls.TControl.Cursor
The value of Cursor is the index of the cursor in the list of cursors maintained by the global variable, Screen. In addition to the built-in cursors provided by TScreen, applications can add custom cursors to the list.
Vcl.Forms.TScreen.Cursors
Custom cursors can be added to the Cursors property for use by the application or any of its controls. To add a custom cursor to an application, you can ...:
...
2. Declare a cursor constant with a value that does not conflict with an existing cursor constant.
...
4. Set the Cursors property, indexed by the newly declared cursor constant, to the handle obtained from LoadCursor.
For example:
const
mycursor: TCursor = 1; // built-in values are <= 0, user-defined values are > 0
procedure Tform1.Button1Click(Sender: TObject);
begin
Screen.Cursors[mycursor] := LoadCursorFromFile('C:\...\Arrow.cur');
Button1.Cursor := mycursor;
end;

Related

Lazarus (Delphi/FPC): constructor in class helper is not executed

I'm trying to find a universal** solution to extend the built-in Treeview/TreeNode by some features such as ToolTips per Node. So first I derived a TExtendedTreeNode = class(TTreeNode) and added a corresponding property which seems to work fine - I can add TExtendedTreeNodes with different ToolTips for each node.
For the next step, I want to use the TTreeView.OnMouseMove event to show the corresponding ToolTip, but what is the best solution to extend this functionality in a universal** way?
My idea was to use a class helper for TTreeView:
type
TTreeViewExtension = class helper for TTreeView
private
procedure ShowNodeToolTips(Sender: TObject; Shift: TShiftState; X, Y: Integer);
public
constructor Create(AnOwner: TComponent);
end;
...
constructor TTreeViewExtension.Create(AnOwner: TComponent);
begin
inherited Create(AnOwner);
ShowMessage('TTreeViewExtension.Create');
self.OnMouseMove := #self.ShowNodeToolTips;
end;
The code is compiled without warnings or errors, but this constructor is NOT executed on creation of a treeview in my form.
And yes, I'm using advancedrecords in objfpc mode in both, my form unit and my extension unit - in order to use the class helper:
{$mode objfpc}{$H+}
{$modeswitch advancedrecords+}
** "universal" means, I want to use the integrated controls from my Lazarus IDE at least for the TreeView control, but use the extended functionality without writing code twice.
Why don't you use the already available OnHint event to show these tooltips. The TTreeView.OnHint event already returns you reference to the tree node that is beneath the mouse cursor so you should not have any problem reading your custom hints (tooltips) from the node.
If the tips can be shown in a single line of text you can simply change the value of Hint variable that is exposed in this event method.
You can easily read such value from your Extended TreeNode by typecasting the Node constant returned by the event method to your TExtendedTreeNode class.
Don't forget to check if the node in question is indeed of the right class.
procedure TForm1.TreeView1Hint(Sender: TObject; const Node: TTreeNode;
var Hint: string);
begin
//Check to see if the node beneath the cursor is the extended node
if Node is TExtendedTreeNode then
//if it is change the hint text to the custom hint stored in the
//node itself
Hint := TExtendedTreeNode(Node).CustomHint
//Else change the hint to empty string so no hintbox will be shown
else Hint := '';
end;
And if you don't want any hint text to be shown and show your information in a different way you simply set the Hint value to an empty string.
procedure TForm1.TreeView1Hint(Sender: TObject; const Node: TTreeNode;
var Hint: string);
begin
//Set Hint to empty string in order to not show any hint box
Hint := '';
//Do some other code instead if you like
MessageBeep(0);
end;

How to replace TListbox Items property with my own published object list based type in a TCustomListBox control?

Overview
This question is a second attempt based on this one I recently asked: How can I make a TList property from my custom control streamable?
Although I accepted the answer in that question and it worked, I soon realized that TCollection is not the solution or requirement I was looking for.
Requirements
To keep my requirements as simple and clear to understand as possible, this is what I am attempting to:
Derive a new custom control based on TCustomListBox
Replace the Items property with my own Items type, eg a TList.
The TList (Items property) will hold objects, each containing a caption and a image index property etc.
Ownerdraw my listbox and draw its icons and text etc.
Create a property editor to edit the Items at design-time.
With that in mind, I know how to create the custom control, I know how to work with TList or even TObjectList for example, I know how to ownerdraw the control and I also know how to create the property editor.
Problem
What I don't know is how to replace the standard listbox Items type with my own? well I kind of do (publishing my own property that shares the same name), only I need to make sure it is fully streamable with the dfm.
I have searched extensively on this subject and have tried studying code where TListView and TTreeView etc publishes its Items type but I have found myself more confused than ever.
In fact I came across this very old question asked by someone else on a different website which asks very much what I want to do: Streaming a TList property of a component to a dfm. I have quoted it below in the event the link is lost:
I recently wrote a component that publishes a TList property. I then created a property editor for the TList to enable design-time editing. The problem is that the TList doesn't stream to the dfm file, so all changes are lost when the project is closed. I assume this is because TList inherits from TObject and not from TPersistant. I was hoping there was an easy work around for this situation (or that I have misunderstood the problem to begin with). Right now all I can come up with is to switch to a TCollection or override the DefineProperties method. Is there any other way to get the information in the TList streamed to and from the dfm?
I came across that whilst searching keywords such as DefineProperties() given that this was an alternative option Remy Lebeau briefly touched upon in the previous question linked at the top, it also seemed to be the answer to that question.
Question
I need to know how to replace the Items (TStrings) property of a TCustomListBox derived control with my own Items (TList) or Items (TObjectList) etc type but make it fully streamable with the dfm. I know from previous comments TList is not streamable but I cannot use TStrings like the standard TListBox control does, I need to use my own object based list that is streamable.
I don't want to use TCollection, DefineProperties sounds promising but I don't know how exactly I would implement this?
I would greatly appreciate some help with this please.
Thank you.
Override DefineProperties procedure in your TCustomListBox (let's name it TMyListBox here). In there it's possible to "register" as many fields as you wish, they will be stored in dfm in the same way as other fields, but you won't see them in object inspector. To be honest, I've never encountered having more then one property defined this way, called 'data' or 'strings'.
You can define 'normal' property or binary one. 'Normal' properties are quite handy for strings, integers, enumerations and so on. Here is how items with caption and ImageIndex can be implemented:
TMyListBox = class(TCustomListBox)
private
//other stuff
procedure ReadData(reader: TReader);
procedure WriteData(writer: TWriter);
protected
procedure DefineProperties(filer: TFiler); override;
//other stuff
public
//other stuff
property Items: TList read fItems; //not used for streaming, not shown in object inspector. Strictly for use in code itself. We can make it read-only to avoid memory leak.
published
//some properties
end;
that's DefineProperties implementation:
procedure TMyListBox.DefineProperties(filer: TFiler);
begin
filer.DefineProperty('data', ReadData, WriteData, items.Count>0);
end;
fourth argument, hasData is Boolean. When your component is saved to dfm, DefineProperties is called and it's possible to decide at that moment is there any data worth saving. If not, 'data' property is omitted. In this example, we won't have this property if there is no items present.
If we expect to ever use visual inheritance of this control (for example, create a frame with this listBox with predefined values and then eventually change them when put to form), there is a possibility to check, is value of this property any different than on our ancestor. Filer.Ancestor property is used for it. You can watch how it's done in TStrings:
procedure TStrings.DefineProperties(Filer: TFiler);
function DoWrite: Boolean;
begin
if Filer.Ancestor <> nil then
begin
Result := True;
if Filer.Ancestor is TStrings then
Result := not Equals(TStrings(Filer.Ancestor))
end
else Result := Count > 0;
end;
begin
Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
end;
This would save a little bit of space (or lots of space if image is stored within) and sure is elegant, but in first implementation it can well be omitted.
Now the code for WriteData and ReadData. Writing is much easier usually and we may begin with it:
procedure TMyListBox.WriteData(writer: TWriter);
var i: Integer;
begin
writer.WriteListBegin; //in text dfm it will be '(' and new line
for i:=0 to items.Count-1 do begin
writer.WriteString(TListBoxItem(items[I]).caption);
writer.WriteInteger(TListBoxItem(items[I]).ImageIndex);
end;
writer.WriteListEnd;
end;
In dfm it will look like this:
object MyListBox1: TMyListBox
data = (
'item1'
-1
'item2'
-1
'item3'
0
'item4'
1)
end
Output from TCollection seems more elegant to me (triangular brackets and then items, one after another), but what we have here would suffice.
Now reading it:
procedure TMyListBox.ReadData(reader: TReader);
var item: TListBoxItem;
begin
reader.ReadListBegin;
while not reader.EndOfList do begin
item:=TListBoxItem.Create;
item.Caption:=reader.ReadString;
item.ImageIndex:=reader.ReadInteger;
items.Add(item); //maybe some other registering needed
end;
reader.ReadListEnd;
end;
That's it. In such a way rather complex structures can be streamed with ease, for example, two-dimensional arrays, we WriteListBegin when writing new row and then when writing new element.
Beware of WriteStr / ReadStr - these are some archaic procedures which exist for backward compatibility, ALWAYS use WriteString / ReadString instead!
Other way to do is to define binary property. That's used mostly for saving images into dfm. Let's say, for example, that listBox has hundreds of items and we'd like to compress data in it to reduce size of executable. Then:
TMyListBox = class(TCustomListBox)
private
//other stuff
procedure LoadFromStream(stream: TStream);
procedure SaveToStream(stream: TStream);
protected
procedure DefineProperties(filer: TFiler); override;
//etc
end;
procedure TMyListBox.DefineProperties(filer: TFiler);
filer.DefineBinaryProperty('data',LoadFromStream,SaveToStream,items.Count>0);
end;
procedure TMyListBox.SaveToStream(stream: TStream);
var gz: TCompressionStream;
i: Integer;
value: Integer;
item: TListBoxItem;
begin
gz:=TCompressionStream.Create(stream);
try
value:=items.Count;
//write number of items at first
gz.Write(value, SizeOf(value));
//properties can't be passed here, only variables
for i:=0 to items.Count-1 do begin
item:=TListBoxItem(items[I]);
value:=Length(item.Caption);
//almost as in good ol' Pascal: length of string and then string itself
gz.Write(value,SizeOf(value));
gz.Write(item.Caption[1], SizeOf(Char)*value); //will work in old Delphi and new (Unicode) ones
value:=item.ImageIndex;
gz.Write(value,SizeOf(value));
end;
finally
gz.free;
end;
end;
procedure TMyListBox.LoadFromStream(stream: TStream);
var gz: TDecompressionStream;
i: Integer;
count: Integer;
value: Integer;
item: TListBoxItem;
begin
gz:=TDecompressionStream.Create(stream);
try
gz.Read(count,SizeOf(count)); //number of items
for i:=0 to count-1 do begin
item:=TListBoxItem.Create;
gz.Read(value, SizeOf(value)); //length of string
SetLength(item.caption,value);
gz.Read(item.caption[1],SizeOf(char)*value); //we got our string
gz.Read(value, SizeOf(value)); //imageIndex
item.ImageIndex:=value;
items.Add(item); //some other initialization may be needed
end;
finally
gz.free;
end;
end;
In dfm it would look like this:
object MyListBox1: TMyListBox1
data = {
789C636260606005E24C86128654865C064386FF40802C62C40002009C5607CA}
end
78 is sort of signature of ZLib, 9C means default compression, so it works (there are only 2 items actually, not hundreds). Of course, this is just one example, with BinaryProperties any possible format may be used, for example saving to JSON and putting it into stream, or XML or something custom. But I'd not recommend to use binary unless it's absolutely inevitable, because it's difficult to see from dfm, what happens in component.
It seems like good idea to me to actively use streaming when implementing component: we can have no designer at all and set all values by manually editing dfm and see if component behaves correctly. Reading/loading itself can be tested easily: if component is loaded, then saved and text is just the same, it's all right. It's so 'transparent' when streaming format is 'human-readable', self-explaining that it often overweighs drawbacks (like file size) if there are any.

Display a warning when dropping a component on a form at design time

I'm tidying up components used in a large legacy project, I've eliminated about 90 of 220 custom components, replacing them with standard Delphi controls. Some of the remaining components require a significant amount work to remove which I don't have available. I would like to prevent anyone from making additional use of some of these components and was wondering if there was a way of showing a message if the component is dropped on the form at design time - something like "Don't use this control, use x or y instead".
Another possibility would to hide the control on the component pallet (but still have the control correctly render on the form at design time).
There is protected dynamic method TComponent.PaletteCreated, which is called only in one case: when we add this component to a form from component palette.
Responds when the component is created from the component palette.
PaletteCreated is called automatically at design time when the component has just been created from the component palette. Component writers can override this method to perform adjustments that are required only when the component is created from the component palette.
As implemented in TComponent, PaletteCreated does nothing.
You can override this method to show warning, so it will alert the user just one time, when he tries to put it to form.
UPDATE
I couldn't make this procedure work in Delphi 7, XE2 and Delphi 10 Seattle (trial version), so it seems that call to PaletteCreated from IDE is not implemented.
I sent report to QC:http://qc.embarcadero.com/wc/qcmain.aspx?d=135152
maybe developers will make it work some day.
UPDATE 2
There are some funny workarounds, I've tried them all this time, works normally. Suppose that TOldBadButton is one of components that shouldn't be used. We override 'Loaded' procedure and WMPaint message handler:
TOldBadButton=class(TButton)
private
fNoNeedToShowWarning: Boolean; //false when created
//some other stuff
protected
procedure Loaded; override;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
//some other stuff
end;
and implementation:
procedure TBadOldButton.Loaded;
begin
inherited;
fNoNeedToShowWarning:=true;
end;
procedure TOldBadButton.WMPaint(var Message: TWMPAINT);
begin
inherited;
if (csDesigning in ComponentState) and not fNoNeedToShowWarning then begin
Application.MessageBox('Please, don''t use this component','OldBadButton');
fNoNeedToShowWarning:=true;
end;
end;
The problem is, this works only for visual components. If you have custom dialogs, imagelists etc, they never get WMPaint message. In that case we can add another property, so when it is shown in object inspector, it calls getter and here we display warning. Something like this:
TStupidOpenDialog = class(TOpenDialog)
private
fNoNeedToShowWarning: boolean;
function GetAawPlease: string;
procedure SetAawPlease(value: string);
//some other stuff
protected
procedure Loaded; override;
//some other stuff
published
//with name like this, probably will be on top in property list
property Aaw_please: string read GetAawPlease write SetAawPlease;
end;
implementation:
procedure TStupidOpenDialog.Loaded;
begin
inherited;
fNoNeedToShowWarning:=true; //won't show warning when loading form
end;
procedure TStupidOpenDialog.SetAawPlease(value: string);
begin
//nothing, we need this empty setter, otherwise property won't appear on object
//inspector
end;
function TStupidOpenDialog.GetAawPlease: string;
begin
Result:='Don''t use this component!';
if (csDesigning in ComponentState) and not fNoNeedToShowWarning then begin
Application.MessageBox('Please, don''t use this component','StupidOpenDialog');
fNoNeedToShowWarning:=true;
end;
end;
Older versions of Delphi always scroll object inspector to the top when new component is added from palette, so our Aaw_please property will surely work. Newer versions tend to start with some chosen place in property list, but non-visual components usually have quite a few properties, so it shouldn't be a problem.
To determine when the component is first created (dropped on the form)?
Override "CreateWnd" and use the following if statement in it:
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
// We have first create
More detail here >>
Link

Delphi: browsing components inside a property editor

When a property is a simple component of any class, the IDE's property editor is able to drop down a list of all compatible components in all the project's forms.
I want to do some equivalent task, but with some filtering based on acceptable component classes for the property; these classes common ancestor is only TComponent and they have custom interfaces.
Currently I have a working property editor that uses a paValueList attribute and some filtering in the GetValues procedure, based on checking the supported interfaces, but it is limited to the current form :-(.
How to browse all the forms like the IDE does?
I want to do some equivalent task, but with some filtering based on acceptable component classes for the property; these classes common ancestor is only TComponent and they have custom interfaces.
If you are filtering for only 1 interface, you should change the property in question to accept that interface type instead of a TComponent, and then the default property editor for interface properties (TInterfaceProperty) will filter the components automatically for you:
property MyProperty: IMyInterface read ... write ...;
Currently I have a working property editor that uses a paValueList attribute and some filtering in the GetValues procedure, based on checking the supported interfaces, but it is limited to the current form :-(.
How to browse all the forms like the IDE does?
To manually filter the components in a custom property editor, you need to do the same thing that the default component property editor (TComponentProperty) does to obtain the compatible components, and then you can filter them further as needed.
Internally, TComponentProperty.GetValues() simply calls Designer.GetComponentNames(), passing it the PTypeData of the property type that is being edited:
procedure TComponentProperty.GetValues(Proc: TGetStrProc);
begin
Designer.GetComponentNames(GetTypeData(GetPropType), Proc);
end;
So, if your property accepts a TComponent (since that is the only common ancestor of your intended components):
property MyProperty: TComponent read ... write ...;
Then GetPropType() in this case would return TypeInfo(TComponent).
GetComponentNames() (whose implementation is in the IDE and not available in the VCL source code) enumerates the components of the Root (Form, DataModule, or Frame) that owns the component being edited, as well as all linked Root objects that are accessible in other units specified in the edited Root's uses clause. This is documented behavior:
DesignIntf.IDesigner60.GetComponentNames
Executes a callback for every component that can be assigned a property of a specified type.
Use GetComponentNames to call the procedure specified by the Proc parameter for every component that can be assigned a property that matches the TypeData parameter. For each component, Proc is called with its S parameter set to the name of the component. This parameter can be used to obtain a reference to the component by calling the GetComponent method.
Note: GetComponentNames calls Proc for components in units that are in the uses clause of the current root object's unit (Delphi) or included by that unit (C++), as well as the entity that is the value of Root.
So, in your GetValues() implementation, call Designer.GetComponentNames() specifying the PTypeData for TComponent and let the IDE enumerate all available units and provide you with a list of each component's Name. Then you can loop through that list calling Designer.GetComponent() to get the actual TComponent objects and query them for your desired interface(s):
procedure TMyComponentProperty.GetValues(Proc: TGetStrProc);
var
Names: TStringList;
I: Integer;
begin
Names := TStringList.Create;
try
Designer.GetComponentNames(GetTypeData(TypInfo(TComponent)), Names.Append);
for I := 0 to Names.Count-1 do
begin
if Supports(Designer.GetComponent(Names[I]), IMyInterface) then
Proc(Names[I]);
end;
finally
Names.Free;
end;
end;
In fact, this is very similar to what the default TInterfaceProperty.GetValues() implementation does:
procedure TInterfaceProperty.ReceiveComponentNames(const S: string);
var
Temp: TComponent;
Intf: IInterface;
begin
Temp := Designer.GetComponent(S);
if Assigned(FGetValuesStrProc) and
Assigned(Temp) and
Supports(TObject(Temp), GetTypeData(GetPropType)^.Guid, Intf) then
FGetValuesStrProc(S);
end;
procedure TInterfaceProperty.GetValues(Proc: TGetStrProc);
begin
FGetValuesStrProc := Proc;
try
Designer.GetComponentNames(GetTypeData(TypeInfo(TComponent)), ReceiveComponentNames);
finally
FGetValuesStrProc := nil;
end;
end;
The only difference is that TInterfaceProperty does not waste memory collecting the names into a temp TStringList. It filters them in real-time as they are being enumerated.
Remy's solution works perfectly for my needs.
Nevertheless I've "simplified" a bit the filtering procedure:
procedure TMyComponentProperty.ReceiveComponentNames(const S: string);
var
Temp: TComponent;
Intf: IInterface;
begin
if Assigned(FGetValuesStrProc) then
begin
Temp := Designer.GetComponent(S);
if Assigned(Temp) then
if Temp.GetInterface(IMyInterface, IntF) then
FGetValuesStrProc(S);
// May add other interfaces checks here
end;
end;

Get all components linked to a datasource

I am currently trying to change properties for hug components depending on state of other component using what RTTI provide but i can't figure out how to retrieve all links between
DataSource and DataAware components...
that's what i would like to achieve
Get all components linked to specific DataSource something like.
iterate through all those components.
if the component accept ReadOnly property (by using RTTI i guess) i would like to change the property depending on the DataSet state:
if DataSource.DataSet.state = dsbrowse then Component[i].ReadOnly := True
if DataSource.DataSet.state = dsEdit then Component[i].ReadOnly := False
thanks in advance for help
I'm not sure what problem you're trying to solve, because setting the TDataSource.AutoEdit property to False should automatically disable editing in the controls until you manually change the DataSet.State to one of the ones in dsEditModes.
With that being said, this will do what you're asking. It uses an accessor class to access the protected DataLinks list in a TDataSource, and then checks to see if it's a TFieldLink and also if it has the ReadOnly property.
// No Delphi version provided, so uses "older style" RTTI
uses
TypInfo, DB, DBCtrls;
type
THackDataSource=class(TDataSource); // accessor class
procedure SetDataSetControlsReadOnly(const DataSource: TDataSource);
var
i: Integer;
DS: THackDataSource;
DL: TDataLink;
EnableIt: Boolean;
begin
EnableIt := DataSource.State in dsEditModes;
DS := THackDataSource(DataSource.DataSet);
for i := 0 to DS.DataLinks.Count - 1 do
begin
DL := DS.DataLinks[i];
if DL is TFieldDataLink then
begin
if IsPublishedProp(DL, 'ReadOnly') then
SetOrdProp(DL, 'ReadOnly', Ord(EnableIt));
end;
end;
end;

Resources