I am trying to follow the example about to disable the color on a control on my form.
TStyleManager.Engine.RegisterStyleHook(ClrMeans.TwwDBComboDLG, TEditStyleHook);
But I am getting an exception when either registering or unregistering either a the 3rd party control (infopower TwwDBComboDlg) or a standard VCL TEdit. Anybody had any issues with this or any suggestions
The link here explains what you need to know.
Basically, you need to either put a "null hook" in, which is what you already knew, or you need to put a "VCL colors" hook in, which is half of what you are missing. The other half is your nil pointer problem.
To make TEdit derivatives (like yours) look like VCL standard colors the code you need to make it work with your control is this:
uses
Winapi.Messages,
Vcl.Controls,
Vcl.StdCtrls,
Vcl.Forms,
Vcl.Themes,
Vcl.Styles;
type
TEditStyleHookColor = class(TEditStyleHook)
private
procedure UpdateColors;
protected
procedure WndProc(var Message: TMessage); override;
constructor Create(AControl: TWinControl); override;
end;
implementation
type
TWinControlH= class(TWinControl);
constructor TEditStyleHookColor.Create(AControl: TWinControl);
begin
inherited;
//call the UpdateColors method to use the custom colors
UpdateColors;
end;
//Here you set the colors of the style hook
procedure TEditStyleHookColor.UpdateColors;
var
LStyle: TCustomStyleServices;
begin
if Control.Enabled then
begin
Brush.Color := TWinControlH(Control).Color; //use the Control color
FontColor := TWinControlH(Control).Font.Color;//use the Control font color
end
else
begin
//if the control is disabled use the colors of the style
LStyle := StyleServices;
Brush.Color := LStyle.GetStyleColor(scEditDisabled);
FontColor := LStyle.GetStyleFontColor(sfEditBoxTextDisabled);
end;
end;
//Handle the messages of the control
procedure TEditStyleHookColor.WndProc(var Message: TMessage);
begin
case Message.Msg of
CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
begin
//Get the colors
UpdateColors;
SetTextColor(Message.WParam, ColorToRGB(FontColor));
SetBkColor(Message.WParam, ColorToRGB(Brush.Color));
Message.Result := LRESULT(Brush.Handle);
Handled := True;
end;
CM_ENABLEDCHANGED:
begin
//Get the colors
UpdateColors;
Handled := False;
end
else
inherited WndProc(Message);
end;
end;
Procedure ApplyVCLColorsStyleHook(ControlClass :TClass);
begin
if Assigned(TStyleManager.Engine) then
TStyleManager.Engine.RegisterStyleHook(ControlClass, TEditStyleHookColor);
end;
initialization
ApplyVCLColorsStyleHook(TwwDBComboDlg);
Your problem with NIL is that if you don't have VCL themes turned on, then Engine is nil, and you should check and just return from that code without calling that function you're calling. Here's where you turn on the themes, in case you missed it:
Interesting side stuff: Get the VCL Styles utils library. Here's an example of using it to change colors of stuff:
TCustomStyleExt(TStyleManager.ActiveStyle).SetStyleColor(scEdit, clWindow);
TCustomStyleExt(TStyleManager.ActiveStyle).SetStyleFontColor(sfEditBoxTextNormal
,clWindowText);
You can create styles, and apply those styles to particular controls, and even expand the theming engine, it might be possible to use the VCL Styles Utils tool to get your desired result, but it will not be trivial.
Related
I want to create my own custom control. Let's say I want to initialize its graphic properties. Obviously I cannot do that in Create because a canvas/handle is not YET allocated.
The same if my custom control contains a subcomponent (and I also set its visual properties).
There are quite several places on SO that discuss the creation of a custom control. They don't really agree on it.
AfterConstruction is out of question because the handle is not ready yet.
CreateWnd seem ok but it actually can be quite problematic as it can be called more than once (for example when you apply a new skin to the program). Probably, some boolean variable should be used to check if CreateWnd was called more than once.
SetParent has the same issue: if you change the parent of your custom control, whatever code you put in its SetParent will be executed again. A bool variable should fix the problem.
Principles
First al all, most of the visual properties of a control do not require the control to have a valid window handle in order to be set. It is a false assumption that they do.
Once the object that constitutes a control is created, i.e. the constructor has been executed, normally all (visual) properties like size, position, font, color, alignment, etc. can be set. Or they should be able to, preferably. For sub controls, also the Parent ideally must be set as soon as the constructor has run. For the component itself, that constructor would be the inherited constructor during its own constructor.
The reason this works is that all these kind of properties are stored within the fields of the Delphi object itself: they are not immediately passed to the Windows API. That happens in CreateWnd but no sooner than when all necessary parent window handles are resolved and assigned.
So the short answer is: the initial setup of a custom component is done in its constructor, because it is the only routine that runs once.
But the question (unintentionally) touches a wide range of topics on component building, because the complexity of an initial setup of a control depends entirely on the type of control and the properties that are to be set.
Example
Consider writing this (useless yet illustrative) component that consists of a panel with a combo box aligned on top of it. The panel should initially have: no caption, a custom height and a silver background. The combo box should have: a custom font size and a 'picklist' style.
type
TMyPanel = class(TPanel)
private
FComboBox: TComboBox;
public
constructor Create(AOwner: TComponent); override;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clSilver;
ShowCaption := False;
Height := 100;
FComboBox := TComboBox.Create(Self);
FComboBox.Parent := Self;
FComboBox.Align := alTop;
FComboBox.Style := csDropDownList;
FComboBox.Font.Size := 12;
end;
Framework conformity
A component writer could now consider it done, but it is not. He/she has the responsibility to write components properly as described by the comprehensive Delphi Component Writer's Guide.
Note that no less then four properties (indicated bold in the object inspector) are needlessly stored in the DFM because of an incorrect designtime component definition. Although invisible, the caption property still reads MyPanel1, which is against te requirements. This can be solved by removing the applicable control style. The ShowCaption, Color and ParentBackground properties lack a proper default property value.
Note too that all default properties of TPanel are present, but you might want some not te be, especially the ShowCaption property. This can be prevented by descending from the right class type. The standard controls in the Delphi framework mostly offer a custom variant, e.g. TCustomEdit instead of TEdit that are there for exactly this reason.
Our example compound control that is rid of these issues looks as follows:
type
TMyPanel = class(TCustomPanel)
private
FComboBox: TComboBox;
public
constructor Create(AOwner: TComponent); override;
published
property Color default clSilver;
property ParentBackground default False;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clSilver;
ControlStyle := ControlStyle - [csSetCaption];
Height := 100;
FComboBox := TComboBox.Create(Self);
FComboBox.Parent := Self;
FComboBox.Align := alTop;
FComboBox.Style := csDropDownList;
FComboBox.Font.Size := 12;
end;
Of course, other implications due to setting up a component are possible.
Exceptions
Unfortunately there áre properties that require a control's valid window handle, because the control stores its value in Windows' native control. Take the Items property of the combo box above for example. Consider a deisgn time requirement of it been filled with some predefined text items. You then should need to override CreateWnd and add the text items the first time that it is called.
Sometimes the initial setup of a control depends on other controls. At design time you don't (want to) have control over the order in which all controls are read. In such case, you need to override Loaded. Consider a design time requirement of adding all menu-items from the PopupMenu property, if any, to the Items property of the combo box.
The example above, extended with these new features, results finally in:
type
TMyPanel = class(TCustomPanel)
private
FInitialized: Boolean;
FComboBox: TComboBox;
procedure Initialize;
protected
procedure CreateWnd; override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
published
property Color default clSilver;
property ParentBackground default False;
property PopupMenu;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clSilver;
ControlStyle := ControlStyle - [csSetCaption];
Height := 100;
FComboBox := TComboBox.Create(Self);
FComboBox.Parent := Self;
FComboBox.Align := alTop;
FComboBox.Style := csDropDownList;
FComboBox.Font.Size := 12;
end;
procedure TMyPanel.CreateWnd;
begin
inherited CreateWnd;
if not FInitialized then
Initialize;
end;
procedure TMyPanel.Initialize;
var
I: Integer;
begin
if HandleAllocated then
begin
if Assigned(PopupMenu) then
for I := 0 to PopupMenu.Items.Count - 1 do
FComboBox.Items.Add(PopupMenu.Items[I].Caption)
else
FComboBox.Items.Add('Test');
FInitialized := True;
end;
end;
procedure TMyPanel.Loaded;
begin
inherited Loaded;
Initialize;
end;
It is also possible that the component depends in some way on its parent. Then override SetParent, but also remember that any dependency on (properties of) its parent likely indicates a design issue which might require re-evaluation.
And surely there are other kind of dependencies imaginable. They then would require special handling somewhere else in the component code. Or another question here on SO. 😉
So, I did this test that shows the creation order.
UNIT cvTester;
{--------------------------------------------------------------------------------------------------
This file tests the initialization order of a custom control.
--------------------------------------------------------------------------------------------------}
INTERFACE
{$WARN GARBAGE OFF} { Silent the: 'W1011 Text after final END' warning }
USES
System.SysUtils, System.Classes, vcl.Controls, vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls;
TYPE
TCustomCtrlTest = class(TPanel)
private
protected
Initialized: boolean;
Sub: TButton;
public
constructor Create(AOwner: TComponent); override;
procedure Loaded; override;
procedure AfterConstruction; override;
procedure CreateWnd; override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure WriteToString(s: string);
procedure SetParent(AParent: TWinControl); override;
published
end;
procedure Register;
IMPLEMENTATION
USES System.IOUtils;
procedure Register;
begin
RegisterComponents('Mine', [TCustomCtrlTest]);
end;
constructor TCustomCtrlTest.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Sub:= TButton.Create(Self);
Sub.Parent:= Self; // Typically, creating a sub-control and setting its Parent property to your main control will work just fine inside of your main control's constructor, provided that the sub-control does not require a valid HWND right way. Remy Lebeau
WriteToString('Create'+ #13#10);
end;
procedure TCustomCtrlTest.Loaded;
begin
inherited;
WriteToString('Loaded'+ #13#10);
end;
procedure TCustomCtrlTest.AfterConstruction;
begin
inherited;
WriteToString('AfterConstruction'+ #13#10);
end;
procedure TCustomCtrlTest.CreateWnd;
begin
WriteToString(' CreateWnd'+ #13#10);
inherited;
WriteToString(' CreateWnd post'+ #13#10);
Sub.Visible:= TRUE;
Sub.Align:= alLeft;
Sub.Caption:= 'SOMETHING';
Sub.Font.Size:= 20;
end;
procedure TCustomCtrlTest.CreateWindowHandle(const Params: TCreateParams);
begin
inherited CreateWindowHandle(Params);
WriteToString(' CreateWindowHandle'+ #13#10);
end;
procedure TCustomCtrlTest.SetParent(AParent: TWinControl);
begin
WriteToString('SetParent'+ #13#10);
inherited SetParent(AParent);
WriteToString('SetParent post'+ #13#10);
if NOT Initialized then { Make sure we don't call this code twice }
begin
Initialized:= TRUE;
SetMoreStuffHere;
end;
end;
procedure TCustomCtrlTest.WriteToString(s: string);
begin
System.IOUtils.TFile.AppendAllText('test.txt', s);
// The output will be in Delphi\bin folder when the control is used inside the IDE (dropped on a form) c:\Delphi\Delphi XE7\bin\
// and in app's folder when running inside the EXE file.
end;
end.
The order is:
Dropping control on a form:
Create
AfterConstruction
SetParent
CreateWnd
CreateWindowHandle
CreateWnd post
SetParent post
Deleting control from form:
SetParent
SetParent post
Cutting ctrol from form and pasting it back:
SetParent
SetParent post
Create
AfterConstruction
SetParent
CreateWnd
CreateWindowHandle
CreateWnd post
SetParent post
SetParent
SetParent post
Loaded
Executing the program
Create
AfterConstruction
SetParent
SetParent post
SetParent
SetParent post
Loaded
CreateWnd
CreateWindowHandle
CreateWnd post
Dynamic creation
Create
AfterConstruction
SetParent
CreateWnd
CreateWindowHandle
CreateWnd post
SetParent post
Reconstructing the form
Not tested yet
The solution I chose in the end is to initialize code that requires a handle in SetParent (or CreateWnd) and use a boolean var to protect from executing that code twice (see SetParent above).
I have created a simple test control inheriting from Tcustom control, which contains 2 panels. The first is a header aligned to the top and client panel aligned to alclient.
I would like the client panel to accept controls from the designer and although I can place controls on the panel, they are not visible at run time and they do not save properly when the project is closed.
The sample code for the control is as follows
unit Testcontrol;
interface
uses Windows,System.SysUtils, System.Classes,System.Types, Vcl.Controls,
Vcl.Forms,Vcl.ExtCtrls,graphics,Messages;
type
TtestControl = class(TCustomControl)
private
FHeader:Tpanel;
FClient:Tpanel;
protected
public
constructor Create(Aowner:Tcomponent);override;
destructor Destroy;override;
published
property Align;
end;
implementation
{ TtestControl }
constructor TtestControl.Create(Aowner: Tcomponent);
begin
inherited;
Fheader:=Tpanel.create(self);
Fheader.Caption:='Header';
Fheader.Height:=20;
Fheader.Parent:=self;
Fheader.Align:=altop;
Fclient:=Tpanel.Create(Self);
with Fclient do
begin
setsubcomponent(true);
ControlStyle := ControlStyle + [csAcceptsControls];
Align:=alclient;
Parent:=self;
color:=clwhite;
BorderStyle:=bssingle;
Ctl3D:=false;
ParentCtl3D:=false;
Bevelouter:=bvnone;
end;
end;
destructor TtestControl.Destroy;
begin
FHeader.Free;
FClient.Free;
inherited;
end;
end.
If I put a button on the test component, the structure shows it as part of the form and not a subcomponent of the test component....and then it doesnt work anyway.
Is there a way to do this?
After plenty of googling around, I found some information which allowed me to cobble together a solution that seems to work.
It seems there two procedures in the base class needs to be overridden to update the control.
The first is the a method called "Loaded" which is called when the streaming has ended.
It seems the streaming places all the sub-panel components placed by the designer on the base component, not on the panel they were originally parent to. So this routine manually reassigns the Parent properties after the loading process has finished.
The second method is called GetChildren, I couldn't find much information as to what this method actually does other than the rather cryptic text in the chm help. However I adapted the overridden code from another example I found on the web which had a similar requirement and it worked. So if anyone can provide some insight as to why this is necessary then that would be useful information.
I have pasted the complete source code for the sample custom component below so that anyone who has a similar requirement in the future, can use it as a starting template for their own components.
unit Testcontrol;
interface
uses Windows, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls,graphics;
type
TtestControl = class(TCustomControl)
private
FHeader:Tpanel;
FClient:Tpanel;
protected
procedure Loaded;override;
procedure GetChildren(Proc:TGetChildProc; Root:TComponent);override;
public
constructor Create(Aowner:Tcomponent);override;
destructor Destroy;override;
published
property Align;
end;
implementation
{ TtestControl }
constructor TtestControl.Create(Aowner:Tcomponent);
begin
inherited;
Fheader:=Tpanel.create(self);
Fheader.setsubcomponent(true);
Fheader.Caption:='Header';
Fheader.Height:=20;
Fheader.Parent:=self;
Fheader.Align:=altop;
Fclient:=Tpanel.Create(Self);
with Fclient do
begin
setsubcomponent(true);
ControlStyle := ControlStyle + [csAcceptsControls];
Align:=alclient;
Parent:=self;
color:=clwhite;
BorderStyle:=bssingle;
Ctl3D:=false;
ParentCtl3D:=false;
Bevelouter:=bvnone;
end;
end;
destructor TtestControl.Destroy;
begin
FHeader.Free;
FClient.Free;
inherited;
end;
procedure TtestControl.Loaded;
var i:integer;
begin
inherited;
for i := ControlCount - 1 downto 0 do
if (Controls[i] <> Fheader) and (Controls[i] <> Fclient) then
Controls[i].Parent := Fclient;
end;
procedure TtestControl.GetChildren(Proc:TGetChildProc; Root:TComponent);
var i:integer;
begin
inherited;
for i := 0 to Fclient.ControlCount-1 do
Proc(Fclient.Controls[i]);
end;
end.
If I have 20 panels on a form (not dynamic) and want to change the color of them when the mouse hovers over them, can I use self.color? I have tried this but it changes the forms color. Somebody suggested that I try assigning each panel to itself by using panel1.assign(panel1), although there was an error that said a TPanel cannot be assigned to itself. I've also tried Form1.free, but that also didn't help.
Do I have to create the panels dynamically to use Self or is there another way?
Assuming you are assigning OnMouse(Enter|Leave) event handlers at design-time, the handlers will belong to your TForm class, that is why the Self pointer refers to the Form object at runtime. Use the handler's Sender parameter instead, that points to the object that is actually triggering the event, eg:
procedure TMyForm.Panel1MouseEnter(Sender: TObject);
begin
TPanel(Sender).Color := ...;
end;
procedure TMyForm.Panel1MouseLeave(Sender: TObject);
begin
TPanel(Sender).Color := ...;
end;
Try this:
type
TPanel = class(Vcl.ExtCtrls.TPanel)
protected
procedure MouseEnter; override;
procedure MouseLeave; override;
end;
implementation
procedure TPanel.MouseEnter;
begin
inherited;
Color := clBlack;
end;
procedure TPanel.MouseLeave;
begin
inherited;
Color := clBtnFace;
end;
Is there any way to exclude VCL Styles from styling a system dialogs' border.
Sepecifically a dialog that is shown by calling MessageDlg or ShowMessage.
I read some articles on "The Road To Delphi" (which is an excellent site btw) but couldn't find the answer.
Here is what i want to achieve:
Now (Carbon Style with styled borders):
Goal (Carbon Style with standard windows borders):
I still want to have styled controls but no styled border.
Removing seBorder from the parent forms StyleElements doesn't do the trick.
Thanks!
MessageDlg() and ShowMessage() are Delphi VCL functions. They dynamically create a Delphi TForm and display that, so you do not have a chance to customise it. However, you can use CreateMessageDialog() instead to create the same TForm, then modify its style elements as needed, and then show it. For instance:
function DoMessageDlgPosHelp(MessageDialog: TForm; X, Y: Integer): Integer;
begin
with MessageDialog do
try
if X >= 0 then Left := X;
if Y >= 0 then Top := Y;
if (Y < 0) and (X < 0) then Position := poScreenCenter;
Result := ShowModal;
finally
Free;
end;
end;
procedure ShowStyledMessage(const Msg: string; const StyleElements: TStyleElements);
var
Form: TForm;
begin
Form := CreateMessageDialog(Msg, mtCustom, [mbOK]);
Form.StyleElements := StyleElements;
DoMessageDlgPosHelp(Form, -1, -1);
end;
Call it like this:
ShowStyledMessage('Some text', [seFont, seClient]);
And the dialog looks like this:
To have styled form without borders you have to remove seBorder from form's StyleElements property.
StyleElements := [seFont, seClient];
But you have to set that property for each and every form. If I understood you correctly you want to show message dialog with Windows border. In that case setting StyleElements property for form that invokes ShowMessage will have no effect on dialog box, because that is completely new form.
What you have to do is to somehow set StyleElements property for dialog form that Delphi creates out of your reach. To do that you have to create your own form StyleHook and replace TFormStyleHook registered for all forms.
Just add following unit in your project and all forms will have Windows border, without the need to set it explicitly for every form.
unit WinBorder;
interface
uses
Winapi.Windows,
Winapi.Messages,
Vcl.Themes,
Vcl.Controls,
Vcl.Forms;
type
TWinBorderFormStyleHook = class(TFormStyleHook)
protected
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AControl: TWinControl); override;
end;
implementation
constructor TWinBorderFormStyleHook.Create(AControl: TWinControl);
begin
inherited;
OverridePaintNC := false;
end;
procedure TWinBorderFormStyleHook.WndProc(var Message: TMessage);
begin
inherited;
if Message.Msg = CM_VISIBLECHANGED then
begin
if (Control is TCustomForm) and (seBorder in TCustomForm(Control).StyleElements) then
TCustomForm(Control).StyleElements := [seFont, seClient];
end;
end;
initialization
TCustomStyleEngine.UnRegisterStyleHook(TCustomForm, TFormStyleHook);
TCustomStyleEngine.UnRegisterStyleHook(TForm, TFormStyleHook);
TCustomStyleEngine.RegisterStyleHook(TCustomForm, TWinBorderFormStyleHook);
TCustomStyleEngine.RegisterStyleHook(TForm, TWinBorderFormStyleHook);
finalization
TCustomStyleEngine.UnRegisterStyleHook(TCustomForm, TWinBorderFormStyleHook);
TCustomStyleEngine.UnRegisterStyleHook(TForm, TWinBorderFormStyleHook);
TCustomStyleEngine.RegisterStyleHook(TCustomForm, TFormStyleHook);
TCustomStyleEngine.RegisterStyleHook(TForm, TFormStyleHook);
end.
I'm using this code to remove the vcl styles from the non client area of a form.
type
TFormStyleHookNC= class(TMouseTrackControlStyleHook)
protected
procedure PaintBackground(Canvas: TCanvas); override;
constructor Create(AControl: TWinControl); override;
end;
constructor TFormStyleHookNC.Create(AControl: TWinControl);
begin
inherited;
OverrideEraseBkgnd := True;
end;
procedure TFormStyleHookNC.PaintBackground(Canvas: TCanvas);
var
Details: TThemedElementDetails;
R: TRect;
begin
if StyleServices.Available then
begin
Details.Element := teWindow;
Details.Part := 0;
R := Rect(0, 0, Control.ClientWidth, Control.ClientHeight);
StyleServices.DrawElement(Canvas.Handle, Details, R);
end;
end;
initialization
TStyleManager.Engine.RegisterStyleHook(TForm3, TFormStyleHookNC);
Before to apply this style hook the form looks like
and after
As you can see the menu disappears, The question is : how I can fix this? I mean how i can remove the vcl styles from the non client area of a form without remove the TMainMenu?
When you uses the vcl styles, the TMain menu is drawn by the TMainMenuBarStyleHook vcl style hook, which is defined inside of the TFormStyleHook (the hook of the forms), in this case because you are not using this hook there is not code to draw the TMainMenu.
Two possible solutions are
1) Implement the vcl style hook for the TMainMenu inside of the TFormStyleHookNC , just like the TFormStyleHook does.
2)or even better use a TActionMainMenuBar component instead of a TMainMenu, this component is very well integrated with the vcl styles (check the next sample image).