TCategoryPanel: How to add controls to header region? - delphi

I've got a TCategoryPanel descendant and would like to add several controls to its header region, like a TComboBox and a TButton for instance.
I took a look at the TCustomCategoryPanel codes and from what I understood it moves controls added to it into its internal FPanelSurface container using a message handler TCustomCategoryPanel.CMControlListChanging for CM_CONTROLLISTCHANGING.
I created a similar message handler in my descendant:
interface
// ...
TElementsCategoryPanel = class(TCategoryPanel)
// ...
private
FObservationTypeSelector: TComboBox;
procedure CMControlListChanging(var Message: TCMControlListChanging);
message CM_CONTROLLISTCHANGING;
// ...
end;
implementation
// ...
constructor TElementsCategoryPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// ...
FObservationTypeSelector := TComboBox.Create(Self);
FObservationTypeSelector.Name := 'ObservationTypeSelector';
FObservationTypeSelector.Parent := Self; // *
// ...
end;
procedure TElementsCategoryPanel.CMControlListChanging(
var Message: TCMControlListChanging);
begin
if not (Message.ControlListItem^.Control = FObservationTypeSelector) then // *
inherited;
end;
Using breakpoints * to step through, the logic works. When FObservationTypeSelector.Parent := Self is set in the constructor, my CMControlListChanging is being called:
If Message.ControlListItem^.Control is not my FObservationTypeSelector combobox, it will call its parent function via inherited.
If Message.ControlListItem^.Control IS my FObservationTypeSelector combobox, it will do nothing, meaning it will keep its assignment from the constructor.
But the code does not seem to have an effect. Afterwards when positioning my combobox after the panel is shown, setting it to FObservationTypeSelector.Top := 0 it remains bound inside the FPanelSurface container, being placed under the header, instead inside of it, as expected.
Current state:
Desired state:
What am I doing wrong here?

Related

Delphi - passing variables to another form (without global variables)

I'm referring to question
Passing the variable to another Form
Is there also a way to handover data - for example from a settings form to the application's main form without using a global variable?
Since you are talking about a "settings form", I assume that the form is shown modally. Then it is actually almost trivial.
As an example, create a new VCL application with a label and a button:
Then create a settings form used to set the font of the main label in the middle. It can look like this, with two TLabel controls, two TEdit controls, two TCheckBox controls, and two TButton controls.
Don't forget to make sure the tab order is correct, that each control has a unique access key (use the FocusControl property of the label to make the connection to the appropriate edit box), that the OK button has Default = True and ModalResult = mrOk, and that the Cancel button has Cancel = True and ModalResult = mrCancel.
(As a bonus, set NumbersOnly = True on the size edit box.)
Now, to pass information between the forms, it is as simple as this:
procedure TfrmMain.btnSettingsClick(Sender: TObject);
var
dlg: TfrmSettings;
begin
dlg := TfrmSettings.Create(Self);
try
// Populate dialog
dlg.eFont.Text := lblCaption.Font.Name;
dlg.eSize.Text := lblCaption.Font.Size.ToString;
dlg.cbBold.Checked := fsBold in lblCaption.Font.Style;
dlg.cbItalic.Checked := fsItalic in lblCaption.Font.Style;
if dlg.ShowModal = mrOk then
begin
// Apply settings from dialog
lblCaption.Font.Name := dlg.eFont.Text;
lblCaption.Font.Size := StrToInt(dlg.eSize.Text);
if dlg.cbBold.Checked then
lblCaption.Font.Style := lblCaption.Font.Style + [fsBold]
else
lblCaption.Font.Style := lblCaption.Font.Style - [fsBold];
if dlg.cbItalic.Checked then
lblCaption.Font.Style := lblCaption.Font.Style + [fsItalic]
else
lblCaption.Font.Style := lblCaption.Font.Style - [fsItalic];
end;
finally
dlg.Free;
end;
end;
The settings form has several possibilities to handover data to application mainform without using global variable. I'll assume that the setting form has bee created by the mainform like this:
SettingForm := TSettingForm.Create(Self);
SettingForm.ShowModal;
When the setting form is done (closed), ShowModal returns and mainform can access any filed (variable) or property of the setting form, before destroying it:
ShowMessage(SettingForm.SomeVariable.ToString);
SettingForm.Free;
Another way to do is to use an event.
type
TSettingFormValueAvailableEvent = procedure (Sender : TObject; Value : Integer) of object;
// Create the form and assign an event handler then show the form
SettingForm := TSettingForm.Create(Self);
SettingForm.OnValueAvailable := SettingFormValueAvailable;
SettingForm.ShowModal;
// The event handler in main form
procedure TForm1.SettingFormValueAvailable(Sender: TObject; Value : Integer);
begin
ShowMessage(Value.ToString);
end;
// The event declaration in TFormSetting
private
FOnValueAvailable : TSettingFormValueAvailableEvent ;
public
property OnValueAvailable : TSettingFormValueAvailableEvent read FOnValueAvailable write FOnValueAvailable;
// The use of the event in the form setting
procedure TFormSetting.Button1.Click(Sender : TObject);
begin
if Assigned(FOnValueAvailable) then
FOnValueAvailable(Self, 1234); // Pass value 1234
end;
Using an event is a little bit more code but it is "real time". The main form can react immediately when something happens while SettingForm is being displayed.

How to HIGHLIGHT a specific popup menu item?

I have this popup menu:
object pmTest: TPopupMenu
OnPopup = pmTestPopup
Left = 32
Top = 24
object mTest1: TMenuItem
Caption = 'Test 1'
OnClick = mTest1Click
end
object mTest2: TMenuItem
Caption = 'Test 2'
OnClick = mTest2Click
end
end
After showing the popup menu with the Popup method, I need to programmatically HIGHLIGHT (not to click!) a specific menu item, so I tried this:
Winapi.Windows.HiliteMenuItem(pmTest.WindowHandle, pmTest.Handle, 1, MF_BYPOSITION or MF_HILITE);
But it does not work.
How can I programmatically HIGHLIGHT a specific popup menu item?
By default, the TPopupMenu.WindowHandle property is set to the Application.Handle window, not to the private HWND that TPopupMenu actually uses internally to actually dispatch its WM_COMMAND messages to. That window is established when the TPopupMenu.Popup() method is called, and it does not update the TPopupMenu.WindowHandle property.
Try using the TPopupList.Window property instead of the TPopupMenu.WindowHandle property for the HWND to pass to HiliteMenuItem(). There is a global PopupList object in the Vcl.Menus unit:
procedure TMyForm.pmTestPopup(Sender: TObject);
begin
Winapi.Windows.HiliteMenuItem({pmTest.WindowHandle}PopupList.Window, pmTest.Handle, 1, MF_BYPOSITION or MF_HILITE);
end;
If that still does not work, then try the Win32 SetMenuItemInfo() function instead, which does not take an HWND for input:
procedure TMyForm.pmTestPopup(Sender: TObject);
var
mii: MENUITEMINFO;
begin
ZeroMemory(#mii, sizeof(mii));
mii.cbSize := sizeof(mii);
mii.fMask := MIIM_STATE;
mii.fState := MFS_HILITE;
Winapi.Windows.SetMenuItemInfoW(pmTest.Handle, 1, True, mii);
end;
UPDATE: Upon further review, the TPopupMenu.OnPopup event is fired BEFORE the menu is made visible, and TPopupMenu may recreate the menu AFTER OnPopup has been called and BEFORE the menu is actually shown. So, your best bet is likely to subclass the TPopupList window so you can intercept the WM_ENTERMENULOOP message, then customize your menu items at that point. For example:
type
TPopupListEx = class(TPopupList)
protected
procedure WndProc(var Message: TMessage); override;
end;
procedure TPopupListEx.WndProc(var Message: TMessage);
begin
inherited;
if (Message.Msg = WM_ENTERMENULOOP) and (Message.WParam = 1) then
begin
// customize pmTest items as needed...
end;
end;
initialization
Popuplist.Free; //free the "default", "old" list
PopupList := TPopupListEx.Create; //create the new one
// The new PopupList will be freed by
// finalization section of Menus unit.
end.

Custom GridPanel ControlItems Issue

I am subclassing TGridPanel to my control TMyGridPanel.
I do this because i want to add 4 default buttons in the GridPanel.
So i override the constructor and create the buttons like:
constructor TMyGridPanel.Create(AOwner: TComponent);
var
i: Integer;
btn: TButton;
begin
inherited Create(AOwner);
for i := 0 to 3 do
begin
btn := TButton.Create(Self);
btn.Parent := Self;
btn.Align := alClient;
btn.Caption := 'Hello World';
btn.Visible := True;
end;
end;
This is working fine.
The ControlCollection Items property shows 4 Buttons as CollectionItems .
Now i want to copy and paste (duplicate) my control because i want to have 2 of it.
However when i do it the buttons don't show up in the control.
The ControlCollection Items property shows 4 Collection Items but they don't have a name (empty).
When i close the form and reopen it the buttons appear.
I am trying to fix this problem for some days now but can't figure it out.
Problem:
When you copy your panel component to clipboard, all its published properties are streamed into text (paste it in notepad to see how it looks).
Pasting to the form reconstructs the component back from this text.
And as ControlCollection property is defined in Vcl.ExtCtrls.TGridPanel as published, buttons within it are included in this text. Here is an excerpt:
object MyGridPanel1: TMyGridPanel
Left = 64
...
ControlCollection = <
item
Column = 0
Control = Button9
Row = 0
end
item
Column = 1
Control = Button10
Row = 0
end
...
object Button9: TButton
Left = 1
...
end
object Button10: TButton
Left = 92
...
end
...
end
When pasting, the IDE designer first creates a new object of class TMyGridPanel. During this step the constructor of TMyGridPanel creates a new set of buttons.
After that all published properties get reconstructed from the text, including the ControlCollection and Buttons within it, and this is where problem lies.
Possible solution:
A possible solution in this situation is to change parent class of TMyGridPanel to TCustomGridPanel
TMyGridPanel2 = class(TCustomGridPanel)
...
TCustomGridPanel (similar to other TCustom... components) does not publish any of its properties, so they won't get streamed into clipboard.
Actually inheriting from TCustom... variants of controls, and not from the one registered in Component Pallet, is the right way to subclass components.
If we now copy this variant of TMyGridPanel2 to clipboard and paste it in notepad, we can see that there no additional properties:
object MyGridPanel21: TMyGridPanel2
Left = 184
Top = 200
Width = 185
Height = 41
end
Drawbacks:
This approach works, but have several cons that has to be noted:
You cannot access custom properties introduced by TGridPanel in Object Inspector (but you can access them at runtime).
A workaround to bring a property back in Object Inspector, is to add it in published section of your component:
TMyGridPanel2 = class(TCustomGridPanel)
public
...
published
property BorderStyle;
property ColumnCollection;
property RowCollection;
...
end;
You cannot change properties of the four buttons via Object Inspector, nor attach events to them. You have to do that in code.
Actually this is good behavior. When you create a composite component that has child controls, it is good practice to have all functionality contained within the component itself.
Full code sample:
unit MyGridPanel2;
interface
uses
Classes, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Controls;
type
TMyGridPanel2 = class(TCustomGridPanel)
private
public
constructor Create(AOwner: TComponent); override;
published
end;
procedure Register;
implementation
{ TMyGridPanel2 }
constructor TMyGridPanel2.Create(AOwner: TComponent);
var
i: Integer;
btn: TButton;
begin
inherited Create(AOwner);
for i := 0 to 3 do
begin
btn := TButton.Create(Self);
btn.Parent := Self;
btn.Align := alClient;
btn.Caption := 'Hello World';
btn.Visible := True;
end;
end;
procedure Register;
begin
RegisterComponents('Custom', [TMyGridPanel2]);
end;
end.
Try this in test project first, not in production.

delphi accessing protected property of TControl [duplicate]

This question already has an answer here:
Accessing protected event of TWinControl
(1 answer)
Closed 8 years ago.
I'm working on delphi components.
I've been trying to access a customized component's designated parent control's onClick event. By designate, users can designate the component's parent control by using object inspector as a property. parent controls can be any of control components on the same form. However, because all parent controls I've made are subclasses of TControl and onClick event of TControl is protected, I can not access parent control's onclick event. practically, a customized component is like a sub-component positioned right next to a parent control, so whenever, a user clicks a customized component, I wanted parent control's click event will occur, if click event exists.
when I run this code, typecasting exception occurs.
procedure TSubCom.SetParentControl(const Value : TControl);
var
parentContLeft : Integer; //parent control's left + width
parentContTop : Integer; //parent control's top
begin
FParentControl := Value;
parentContLeft := FParentControl.Left + FParentControl.Width;
parentContTop := FParentControl.Top;
Left := parentContLeft - (Width div 2);
Top := parentContTop - (Height div 2);
Repaint;
end;
//TSubCom's onClick event is linked with its parent control's onClick event
procedure TSubCom.Click;
var
Parent: wrapClass;
begin
inherited;
if(FParentControl <> nil) then
begin
ShowMessage(FPArentControl.Name);
Parent := FParentControl as wrapClass;
ShowMessage('1');
if Assigned(Parent.OnClick) then
begin
Parent.OnClick(Self);
end;
// FParentControl as FParentControl.ClassType;
// if(FParentControl.OnClick <> nil) then
// FParentControl.OnClick;
end;
end;
Declare a class for accessing protected members,
typecast the Parent to this class, and do not use the OnClick event, instead use Click.
type
TControlAccess = class(TControl);
procedure TSubCom.Click;
begin
inherited Click;
if ParentControl <> nil then
TControlAccess(ParentControl).Click;
end;

Setting multiple labels to transparent across 1.000 forms?

I skinned my software with Devexpress and I found that the labels were non-transparent causing them to have grey background.
There's just endless forms, so I was wondering whether there was a way to do this task (of setting labels to transparent) automatically.
I did a similar thing earlier, the Devexpress controls on the form had LookAndFeel.NativeStyle = True, I used Grep Search to replace it to False on all dfm forms. In the label's case however, the transparent property is not present.
Thank you.
The global Screen variable keeps track of all forms:
procedure MakeLabelsTransparent(AParent: TWinControl);
var
I: Integer;
begin
with AParent do
for I := 0 to ControlCount - 1 do
if Controls[I] is TLabel then
TLabel(Controls[I]).Transparent := True
else if Controls[I] is TWinControl then
MakeLabelsTransparent(TWinControl(Controls[I]));
end;
procedure TMainForm.ActiveFormChange(Sender: TObject);
begin
with Screen do
if (ActiveCustomForm <> nil) and (ActiveCustomForm.Tag = 0) then
begin
MakeLabelsTransparent(ActiveCustomForm);
ActiveCustomForm.Tag := 1;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Screen.OnActiveFormChange := ActiveFormChange;
end;
And if you have to use the Tag property for a particular form, then omit this check: it wouldn't really get that much slower.
For this type of task, GExperts contains the Set Component Properties tool:
This tool waits in the background
until you compile a project. It then
scans the current project's forms to
check for components with certain
properties and changes those
properties to a defined value. This
tool is useful to deactivate datasets
or database connections before you
compile your applications, but it can
be used for any similar situations as
well. To activate the scanning,
enable the checkbox next to this
expert in the GExperts Configuration
screen.
It can be used to set a property which is not yet in the DFM as well, and only requires one additional entry in the GExpert configuration, and a recompile.
I have just tested it and it works as expected.
At design time, you can just parse all .dfm then add the
Transparent = True
line just after any
object MyLabel : TLabel
line.
At runtime, you may override the TCustomForm.DoCreate and TCustomFrame.Create methods, as such:
type
THookedForm = class(TCustomForm)
procedure HookedDoCreate;
end;
THookedFrame = class(TCustomFrame)
constructor Create(AOwner: TComponent); override;
end;
var
PatchForm, OriginalForm: TPatchEvent;
PatchPositionForm: PPatchEvent = nil;
PatchFrame, OriginalFrame: TPatchEvent;
PatchPositionFrame: PPatchEvent = nil;
procedure PatchCreate;
var ov: cardinal;
begin
// hook TForm:
PatchPositionForm := PPatchEvent(#THookedForm.DoCreate);
OriginalForm := PatchPositionForm^;
PatchForm.Jump := $E9; // Jmp opcode
PatchForm.Offset := PtrInt(#THookedForm.HookedDoCreate)-PtrInt(PatchPositionForm)-5;
if not VirtualProtect(PatchPositionForm, 5, PAGE_EXECUTE_READWRITE, #ov) then
RaiseLastOSError;
PatchPositionForm^ := PatchForm; // enable Hook
// hook TFrame:
PatchPositionFrame := PPatchEvent(#TCustomFrame.Create);
OriginalFrame := PatchPositionFrame^;
PatchFrame.Jump := $E9; // Jmp opcode
PatchFrame.Offset := PtrInt(#THookedFrame.Create)-PtrInt(PatchPositionFrame)-5;
if not VirtualProtect(PatchPositionFrame, 5, PAGE_EXECUTE_READWRITE, #ov) then
RaiseLastOSError;
PatchPositionFrame^ := PatchFrame; // enable Hook
end;
{ THookedForm }
procedure THookedForm.HookedDoCreate;
var i: integer;
begin
// enumerate all labels, then set Transparent := true
for i := 0 to Components.Count-1 do
if Components[i] is TLabel then
TLabel(Components[i]).Transparent := true;
DoCreate; // call initial code
end;
{ THookedFrame }
constructor THookedFrame.Create(AOwner: TComponent);
var i: integer;
begin
// enumerate all labels, then set Transparent := true
for i := 0 to Components.Count-1 do
if Components[i] is TLabel then
TLabel(Components[i]).Transparent := true;
inherited Create(AOwner); // call normal constructor
end;
....
initialization
PatchCreate;
A related tip (I always forget to make use of this handy feature):
Configure the label the way you want to have it;
Select it on the form;
Go to Component/Create component template;
You can then a name for the template:
From then on, the template appears as a new component type in your tool palette, with the settings that you prefer.
(Yeah, I know this doesn't change current labels)
You can set the BackColor property to Color.Transparent.
The following should work: the transparent-property is present in the DFM-file only if the value is not the default. So you can us a Grep-Search to insert the "Transparent=TRUE" just in the next line after the "=TLabel". I have not tried this myself, but it is easy to try...

Resources