I am trying to create a custom control based on the TCustomComboBox in Delphi 2007, But I am stuck on the first hurdle.
I am trying to override the way the drop down is displayed, primarally the text that is displayed, looking at the source for TCustomComboBox in stdctrls.pas it looks like i just need to override DrawItem but it is not working, as the code in my overridden method is never executed.
I have looked a several open source components source code to see how they do it, but I am still at a loss.
Here is what I have so far (not much admittedly)
type
TKeyValueComboBox = class(TCustomComboBox)
private
{ Private declarations }
//FColumns:Integer;
protected
{ Protected declarations }
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
end;
And
procedure TKeyValueComboBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
begin
TControlCanvas(Canvas).UpdateTextFlags;
if Assigned(OnDrawItem) then OnDrawItem(Self, Index, Rect, State)
else
begin
Canvas.FillRect(Rect);
Canvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]+'-HELLO');
end;
end;
Does anyone know what method I need to use to get my overridden version of fire? or what I am doing wrong?
Any help would be appreciated.
There also is a property that has to be set, from memory it's DrawingStyle := dsCustomDraw
Put that in the constructor or Loaded.
Did you enable owner-drawing? By default it's deactivated. Try to get the custom drawing work with a standard combo box and create your custom control afterwards, applying all the necessary settings.
Related
In the Firemonkey's TListview the visibility of the scroll bar depends whether the system has a touch screen. How can I override this behavior and show vertical scrolling always when there is not enough room on the list view to display all list items?
I saw within TListViewBase.Create that the scroll visibility depends again on the function result of HasTouchTracking and this depends if TScrollingBehaviour.TouchTracking is set in SystemInformationService.GetScrollingBehaviour.
Does anyone have a glue how I can override this behavior?
A while ago I "threw together" (in a hurry) this unit to override GetScrollingBehaviour for Windows. You could do something similar for whichever platform(s) you want to override it for. In the Create method, I remove the installed service, but keep a reference to it for the parts that are not overridden, then replace it with my own.
unit DW.ScrollingBehaviourPatch.Win;
// This unit is used for testing of "inertial" scrolling of listviews etc on devices that do not have touch capability
interface
implementation
uses
FMX.Platform;
type
TPlatform = class(TInterfacedObject, IFMXSystemInformationService)
private
class var FPlatform: TPlatform;
private
FSysInfoService: IFMXSystemInformationService;
public
{ IFMXSystemInformationService }
function GetScrollingBehaviour: TScrollingBehaviours;
function GetMinScrollThumbSize: Single;
function GetCaretWidth: Integer;
function GetMenuShowDelay: Integer;
public
constructor Create;
destructor Destroy; override;
end;
{ TPlatform }
constructor TPlatform.Create;
begin
inherited;
if TPlatformServices.Current.SupportsPlatformService(IFMXSystemInformationService, FSysInfoService) then
TPlatformServices.Current.RemovePlatformService(IFMXSystemInformationService);
TPlatformServices.Current.AddPlatformService(IFMXSystemInformationService, Self);
FPlatform := Self;
end;
destructor TPlatform.Destroy;
begin
//
inherited;
end;
function TPlatform.GetCaretWidth: Integer;
begin
Result := FSysInfoService.GetCaretWidth;
end;
function TPlatform.GetMenuShowDelay: Integer;
begin
Result := FSysInfoService.GetMenuShowDelay;
end;
function TPlatform.GetMinScrollThumbSize: Single;
begin
Result := FSysInfoService.GetMinScrollThumbSize;
end;
function TPlatform.GetScrollingBehaviour: TScrollingBehaviours;
begin
Result := [TScrollingBehaviour.Animation, TScrollingBehaviour.TouchTracking];
end;
initialization
TPlatform.Create;
end.
For Dave's proposed workaround, the touch tracking needs to be turned off as follows:
function TPlatformListViewWorkaround.GetScrollingBehaviour: TScrollingBehaviours;
begin
result := fSysInfoService.GetScrollingBehaviour - [TScrollingBehaviour.TouchTracking];
end;
With this solution, however, you have to accept that the listview on touchscreen systems can no longer be scrolled with the finger.
That's why I have now opened a change request in the Embarcadero Quality Central and suggested a solution proposal by extending the TListView with a new property SuppressScrollBarOnTouchSystems (RSP-26584).
I want to override the OnPaint-Event of the TBCDProgressBar Component. It's a component for Lazarus (freepascal), I tagged Delphi on purpose because there are no differences when overriding events, and I want as much help as I can get.
TBCDProgressBar has no OnPaint event in its decleration:
TBCDProgressBar = class(TCDProgressBar)
private
FBCThemeManager: TBCThemeManager;
procedure SetFBCThemeManager(AValue: TBCThemeManager);
public
constructor Create(AOwner: TComponent); override;
published
property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
end;
My first approach was to trace down TBCDProgressBar until I would find the OnPaint-Event.
Result was:
TCDProgressBar = class(TCDControl)
TCDControl = class(TCustomControl)
TCustomControl = class(TWinControl)
And finally in TCustomControl I found property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
I don't understand how I can override OnPaint from TCustomControl so that it affects the TBCDProgressBar.
Edit://
I didn't know you can override it as usual, so here is the solution for anyone having the same problem:
TBCDProgressBarWithOnPaint = class(TBCDProgressBar)
protected
procedure Paint; override;
end;
procedure TBCDProgressBarWithOnPaint.Paint;
begin
inherited;
// drawing a line on Progressbar
Canvas.Pen.Color:=clRed;
Canvas.Line(200,0,200,20);
end;
If it is visible (protected, public or published) and virtual, then you can override it no matter how far up the tree it is, just as if it were declared in TProgressBar.
I have done a very simply subclass of the TSwitch that will not respond to mouse clicks or even allow setting IsChecked at runtime. I have not created this as a component so its only runtime constructed. It works if I create a TSwitch at runtime but will not work if its my subclassed switch.
TLayoutSwitch = class(TCustomSwitch, ILayoutBaseControl)
The issue appears to be in SendMessage called by TSwitchModel.SetValue. In TMessageSender.SendMessage. I cannot figure out how TSwitchModel is constructed so that the Receiver object is set.
RAD Studio 10 Seattle
TLayoutSwitch = class(TCustomSwitch, ILayoutBaseControl)
private
FGroupID: integer;
procedure SetGroupID(const Value: integer);
function GetIBHeight: Single;
function GetIBWidth: Single;
procedure SetIBHeight(const Value: Single);
procedure SetIBWidth(const Value: Single);
procedure DoSwitchEvent(Sender: TObject);
public
LayoutControlType: TLayoutControlType;
property LFIBGroup_ID: integer read FGroupID write SetGroupID;
property LFIBWidth: Single read GetIBWidth write SetIBWidth;
property LFIBHeight: Single read GetIBHeight write SetIBHeight;
procedure WriteToStream(ms: TStream);
procedure ReadFromStream(ms: TStream; NewWidth: Single = 1; NewHeight: Single = 1);
constructor Create(AOwner: TComponent); override;
end;
Instantiate code
ctrl := TLayoutSwitch.Create(Background);
ctrl.Parent := Background;
ctrl.BringToFront;
(ctrl as ILayoutBaseControl).ReadFromStream(ms, Background.Width/tmpW, Background.Height/tmpH);
Your class name TLayoutSwitch "misguides" FMX to search for a presenter named LayoutSwitch-style which of course doesn't exist in the framework. However, it is possible to change that name to the ordinary Switch-style in the OnPresentationNameChoosing event which is fired directly after the standard name construction.
Declare a TPresenterNameChoosingEvent procedure in your class, for example:
procedure ChoosePresentationName(Sender: TObject; var PresenterName: string);
and assign this to the event in the constructor
constructor TLayoutSwitch.Create(Owner: TComponent);
begin
inherited;
OnPresentationNameChoosing := ChoosePresentationName;
...
end;
Implementation could be as simple as
procedure TLayoutSwitch.ChoosePresentationName(Sender: TObject; var PresenterName: string);
begin
PresenterName := 'Switch-style';
end;
The Switch-style presenter/presentation is the one used by TSwitch. Therefore it now looks and behaves the same.
I need to write a TQuery descendant with an override on onBeforePost event where I should check the state if its dsInsert or dsEdit or not... and allow or not the post to proceed, but I need someone with experience with custom components to double-check it.
It's been long since I created my components and I'm a bit rusty. Can you take a look at what I got and tell me if I am doing it right?
Here is my code for the component
unit MxQuery;
interface
uses
SysUtils, Classes, DB, DBTables;
type
TMxQuery = class(TQuery)
procedure DoBeforePost; override;
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
constructor Create(AOwner:TComponent); override;
end;
procedure Register;
implementation
constructor TMxQuery.Create(AOwner:Tcomponent);
begin
inherited create(AOwner);
end;
procedure Register;
begin
RegisterComponents('Samples', [TMxQuery]);
end;
procedure TMxQuery.DoBeforePost;
begin
case self.DataSource.State of
dsEdit,dsInsert:
begin
//Do nothing or other stuff
end;
else
begin
self.DataSource.DataSet.Cancel;
Abort;
end;
end;
inherited;
end;
end.
Thanks
Imho, this question fits https://codereview.stackexchange.com/ much better.
Anyway, let me point something out:
Your code should be working.
As #SirRufo said, you unnecessarily raised visibility of method DoBeforePost to published. Look for this this method in declaration TQuery or one of its ancestors. Override the method with the same visibility found there.
Constructor TMxQuery.Create is not needed, as it does not add anything.
I have created a component with TFrame as ancestor with the following code:
type
TCHAdvFrame = class(TFrame)
private
{ Private declarations }
FOnShow : TNotifyEvent;
FOnCreate : TNotifyEvent;
protected
procedure CMShowingChanged(var M: TMessage); message CM_SHOWINGCHANGED;
public
{ Public declarations }
constructor Create(AOwner: TComponent) ; override;
published
property OnShow : TNotifyEvent read FOnShow write FOnShow;
property OnCreate : TNotifyEvent read FOnCreate write FOnCreate;
end;
implementation
{$R *.dfm}
{ TCHAdvFrame }
procedure TCHAdvFrame.CMShowingChanged(var M: TMessage);
begin
inherited;
if Assigned(OnShow) then
begin
ShowMessage('onShow');
OnShow(self);
end;
end;
constructor TCHAdvFrame.Create(AOwner: TComponent);
begin
ShowMessage('OnCreate1');
inherited ;
ShowMessage('OnCreate2');
if Assigned(OnCreate) then
begin
ShowMessage('OnCreate3');
OnCreate(self);
end;
I have registered the new component and did some tests. ShowMessage('OnCreate1'); and ShowMessage('OnCreate2'); are correctly executed but not ShowMessage('OnCreate3');
This prevents to add code during the implementation of a new instance of TCHAdvFrame.
Why is it and how can I solve this ?
A frame is streamed in as part of its ultimate owner's constructor. Typically that will be a form. The form processes the .dfm file. It encounters new objects and creates them. Then it sets the properties of the newly created object. So, the frame's properties are set after its constructor returns.
This is the reason that TFrame does not have an OnCreate event. There is simply no way for the event to be fired because the event by necessity is assigned too late. The VCL designers omitted this event for the very same reason that led you to ask this question. So I do suspect that you likewise should not add this event.
How to solve this? Hard to say for sure unless we had a more detailed description of the problem. Perhaps you could override the frame's Loaded method to good effect. Or perhaps all you need to do is let consumers of your component override the constructor in their derived frames.
Related reading: http://delphi.about.com/od/delphitips2007/qt/tframe_oncreate.htm