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;
Related
I want to set an event OnClick to all TMenuItems on the screen to do what the event currently does, and another few lines of code. I am currently using Delphi 5
For example, say that I have a TMenuItem with the code:
procedure TdesktopForm.MenuFoo1Click(Sender: TObject);
begin
ShowMessage(TComponent(Sender).Name)
end;
and I also have the following procedure:
procedure TdesktopForm.bar;
begin
ShowMessage('extra')
end;
And I want to everytime I click the TMenuItem the program show the TMenuItem's name and also the 'extra' message.
The example shown is just a demonstration of my problem, as in the real software I have over 300 menu items, I want to do this generically, so I won't have to add extra lines of code to all current menu clicks, nor add them when I add new menu items. The order of execution (between the menu click and the extra block of code) doesn't matter.
I tried using TActionList but I couldn't retrieve the object triggering the action, hence, I can't print it's name. I tried using ActiveControl but it always return the focused currently focused object, not the actual menu that I clicked. And also, the TAction execute event overwrites my TMainMenu.OnClick event
As long as all your event handlers are assigned at some point (either at design time or at run time) and don't change afterwards, you can do something like this:
Enumerate all menu items in the menu
For each create an object like the one described below
type
TEventInterceptor = class(TComponent)
private
FOrigEvent: TNotifyEvent;
FAdditionalEvent: TNotifyEvent;
procedure HandleOnClick(_Sender: TObject);
public
constructor Create(_MenuItem: TMenuItem; _AdditionalEvent: TNotifyEvent);
end;
constructor TEventInterceptor.Create(_MenuItem: TMenuItem; _AdditionalEvent: TNotifyEvent);
begin
inherited Create(_MenuItem);
FOrigEvent := _MenuItem.OnClick;
FAdditionalEvent := _AdditionalEvent;
_MenuItem.OnClick := HandleOnClick;
end;
procedure TEventInterceptor.HandleOnClick(_Sender: TObject);
begin
FOrigEvent(_Sender);
FAdditinalEvent(_Sender);
end;
Note that this code is completely untested and may not even compile.
I'm also not sure whether this works with Delphi 5. It does with Delphi 6 though, so chances are good.
Edit:
Some additional notes (thanks for the comments):
Inheriting this class from TComponent makes the form free it automatically when it is being destroyed.
HandleOnClick should possibly check if FOrigEvent is assigned before calling it.
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
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;
I have a custom component (TScrollBox) that when dropped on a form, it will add a label inside the ScrollBox. How can I disable the ScrollBox's events (onClick, OnMouseDown, ect..) and instead enable the events for the child (Tlabel)
unit MyScrollBox;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls;
type
TMyScrollComponent = class(TScrollBox)
private
FLabel : TLabel;
procedure SetLabelText(AText : string);
function GetLabelText : string;
protected
constructor Create(AOwner : TComponent); override;
published
property LabelText : string read GetLabelText write SetLabelText;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TMyScrollComponent]);
end;
constructor TMyScrollComponent.Create(AOwner : TComponent);
begin
inherited;
FLabel := TLabel.Create(self);
FLabel.Parent := self;
FLabel.Caption := 'Hello From Scrollbox!';
end;
procedure TMyScrollComponent.SetLabelText(AText : string);
begin
FLabel.Caption := AText;
end;
function TMyScrollComponent.GetLabelText : string;
begin
result := FLabel.Caption;
end;
end.
The published events in TScrollBox cannot be suppressed in derived classes. So, treating your question literally, there is no way to achieve what you ask.
What you could do is derive from TScrollingWinControl. This is the ancestor to TScrollBox. It doesn't publish the events that you want to associate with the control contained in your scroll box.
Then you can surface events in your custom control that are connected to the control contained in your custom control.
Judging from your recent questions I cannot help in thinking that your approach is wrong. I feel that you should have a custom control that has built in scrolling capability.
The event handlers for TControls are declared as protected and dynamic. Redeclare them using the override directive in your derived class - see TScrollBox Members Protected Methods;
To override MouseDown, add the MouseDown method to the TDBCalendar class and many other pages.
But: If you want to implement your own new events you'd have to do something like this:
...
private
fNewEvent:TNotifyEvent;
procedure setNewEvent(notify:TNotifyEvent);
function getNewEvent:TNotifyEvent;
procedure DoOnNewEvent;
....
published
property OnNewEvent:TNotifyEvent read getNewEvent write setNewEvent;
i.e. - You need to implement a property of a method type, like TNotifyEvent which is built into Delphi. You can also create your own if you need to. If you want to see your event in the IDE like other Delphi components' events, you must declare it as published.
Then: In your new component implementation section do something like this:
procedure TMyclass.DoOnNewEvent;
begin
if assigned (fNewEvent) then
begin
....doStuff...
fNewEvent(self);
end;
end;
You call DoOnNewEvent when the event that you want to control 'happens' in your code, so that the function assigned to fNewEvent will get called at that point in your code. (This is commonly known as a callback - when something "happens" in module A it calls back into module B letting it know that it happened, etc.)
If you want to define new GUI behavior, you have to examine the controls you're interested in and understand how to capture their actual "physical" events - i.e. when did the scrollbar scroll, when was the mouse clicked, and when that happens you call your DoOnNewEvent method. (This generally involves inspecting Windows messages coming into your application, "message cracking",etc - these messages inform your application of what's happening in "the outside world".)
In your consumer class, for example your main form where you're putting your scroll box, once you successfully publish your new event, you will see your event in the IDE on your new component, and you assign it and define the behavior you want for it in your consumer class, just like any other event in the IDE.
Take a look at the VCL source code for a simple component to get a better idea of what it looks like.
But: That's only if you really need your own new published events because overriding the parent's events is not sufficient for your needs.
i'm writing a delphi 2009 app that uses a TTreeView on a docking panel.
i saw i could make big simplifications in my app if i subclassed the TTreeNode. the tree view it's on is placed on a docking panel.
TInfoTreeNode=class(TTreeNode)
private
// remember some stuff
public
end;
procedure TfraInfoTree.tvInfoCreateNodeClass(Sender: TCustomTreeView;
var NodeClass: TTreeNodeClass);
begin
NodeClass:=TInfoTreeNode;
end;
i think i've hit a wall though...each "TInfoTreeNode" instance needs to remember things about itself. since the handles are freed when the panel containing the TTreeView auto-hides, the classes are destroyed.
that's a problem because then everything the classes knew is then forgotten.
is there a way around this (other than reloading every TInfoTreeNode from the database again)?
thank you!
IIRC, the Tag Data property on each TTreeNode instance is preserved through the handle rebuild.
You could either use this as an index into a List containing objects with additional information, or use type-casting to store an object reference and access the objects directly.
the problem is caused by the wrong implementation of your custom TreeNode - it doesn't preserve its information when the TreeView's parent window gets recreated after it has been hodden. As a solution, create a TTreeView descendant and override its DestroyWnd method, to preserve your custom values. For example, take a look at how the TCustomTreeView.DestroyWnd method is implemented.
Having looked at TCustomTreeView.DestroyWnd like Joe Meyer proposes, I would suggest you revert to using the TreeNode.Data property, and store a reference to objects of a new class inheriting from TObject directly. The OnDeletion event of the TreeView offers a good spot to put the destruction code: "TMyObject(Node.Data).Free;"
Usage is pretty similar except you'll need to use "TMyObject(Node.Data)" instead of "TMyNode(Node)". A warning though: experience has taught me to pay close attention not to forget the ".Data" part, since "TMyObject(Node)" will not throw a compile error and raise access violations at run-time.
thank you all for your replies!
i have for 10 years been using the tree view using TTreeNode's data property. i wanted to be free of:
setting the Data property
creating/destroying the "data" object in a manner so there are no memory leaks
i have used the Data property for an ID number in the past as well.
today, my nodes have GUIDs to find their data in the database so they don't "fit" into the Data property anymore.
using a descendant of TTreeNode seems to have addressed my wishes nicely but in order to make that work nicely i had to do a few things:
handle TTreeView.OnCreateNodeClass event
handle TTreeView.OnDeletion event to retrieve latest data from the nodes before they are destroyed
handle TTreeView.OnAddition event to: 1) maintain a simple list of the nodes 2) set the node's Data property so we can use it to find the place in the list allocated for storing it's data.
here's the code:
TInfoTreeNodeMemory=record
...
end;
TInfoTreeNode=class(TTreeNode)
private
m_rInfoTreeNodeMemory:TInfoTreeNodeMemory;
public
property InfoTreeNodeMemory:TInfoTreeNodeMemory read m_rInfoTreeNodeMemory write m_rInfoTreeNodeMemory;
end;
TInfoTreeNodeMemoryItemList=class
private
m_List:TList<TInfoTreeNodeMemory>;
public
constructor Create;
destructor Destroy; override;
procedure HandleOnDeletion(Node: TInfoTreeNode);
procedure HandleOnAddition(Node: TInfoTreeNode);
end;
TfraInfoTree = class(TFrame)
tvInfo: TTreeView;
procedure tvInfoCreateNodeClass(Sender: TCustomTreeView;
var NodeClass: TTreeNodeClass);
procedure tvInfoDeletion(Sender: TObject; Node: TTreeNode);
procedure tvInfoAddition(Sender: TObject; Node: TTreeNode);
private
m_NodeMemory:TInfoTreeNodeMemoryItemList;
...
procedure TfraInfoTree.tvInfoCreateNodeClass(Sender: TCustomTreeView;
var NodeClass: TTreeNodeClass);
begin
// THIS IS VITAL!
NodeClass:=TInfoTreeNode;
end;
procedure TfraInfoTree.tvInfoDeletion(Sender: TObject; Node: TTreeNode);
begin
m_NodeMemory.HandleOnDeletion(TInfoTreeNode(Node));
end;
procedure TfraInfoTree.tvInfoAddition(Sender: TObject; Node: TTreeNode);
begin
m_NodeMemory.HandleOnAddition(TInfoTreeNode(Node));
end;
g_icTreeNodeNotInList=MAXINT;
procedure TInfoTreeNodeMemoryItemList.HandleOnDeletion(Node: TInfoTreeNode);
var
iPosition:integer;
begin
iPosition:=integer(Node.Data);
if iPosition=g_icTreeNodeNotInList then
raise Exception.Create('Node memory not found!')
else
// we recognize this node; store his data so we can give it back to him later
m_List[iPosition]:=Node.InfoTreeNodeMemory;
end;
procedure TInfoTreeNodeMemoryItemList.HandleOnAddition(Node: TInfoTreeNode);
var
iPosition:integer;
begin
// "coat check" for getting back node data later
iPosition:=integer(Node.Data);
if iPosition=g_icTreeNodeNotInList then
begin
// Node.Data = index of it's data
// can't set Node.Data in OnDeletion so we must assign it in OnAddition instead
Node.Data:=pointer(m_List.Count);
// this data may very well be blank; it mostly occupies space; we harvest the real data in OnDeletion
m_List.Add(Node.InfoTreeNodeMemory);
end
else
// we recognize this node; give him his data back
Node.InfoTreeNodeMemory:=m_List[iPosition];
end;
very cool...it meets all my objectives!
to add a node to the tree, all i need to do is:
// g_icTreeNodeNotInList important so the "coat check" (TInfoTreeNodeMemoryItemList)
// can recognize this as something that's not in it's list yet.
MyInfoTreeNode:=TInfoTreeNode(tvInfo.Items.AddChildObject(nParent, sText, pointer(g_icTreeNodeNotInList))));