In a Delphi 10.4.2 32-bit VCL application on Windows 10, I am trying to customize the Hint Font.Size:
type
TExHint = class(THintWindow)
constructor Create(AOwner: TComponent); override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TExHint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
with Canvas.Font do
begin
//Name := 'Verdana';
Size := 15;
//Style := [fsBold, fsItalic];
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HintWindowClass := TExHint;
end;
But it does not work.
How can I customize the Hint Font.Size of my application?
It's much easier than this.
Just set the Screen.HintFont property:
procedure TForm.FormCreate(Sender: TObject);
begin
Screen.HintFont.Size := 20;
end;
or even
or
Related
What I'm basically trying to create is a component that inherits from TScrollBox. That component has a TGroupBox and inside it a TFlowPanel. What I need is when I double click this component, a TCollection-like editor appears where I can add components (TFiltros) that will be children of that TFlowPanel. The problem is that I want those components to be named, such that I can directly access them via code, kinda like a TClientDataSet, where you add fields and they appear in your code.
I've managed to make it almost work by overriding GetChildren and making it return the children of the TFlowPanel. That also required me to make TFiltros's owner be the Form which they are in. It shows in the Structure panel as children (even tho they are not direct children) and also saves it in the DFM, but when I close the form and open it again, it fails to load the data back from the DFM, throwing an Access Violation. I have no idea how to override the loading to properly set the children.
Any help in how I can fix that, or even different ideas would be really nice. I'm new to creating Delphi components.
My current code which is heavily inspired in this question:
unit uFiltros;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Forms, StdCtrls,
ClRelatorio, Math, DesignEditors, DesignIntf, System.Generics.Collections;
type
TFiltrosEditor = class(TComponentEditor)
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): String; override;
function GetVerbCount: Integer; override;
end;
TFiltros = class(TScrollingWinControl)
private
FChilds: TList<TComponent>;
FGroupBox: TGroupBox;
FFlowPanel: TFlowPanel;
FWidth: Integer;
procedure OnFlowPanelResize(Sender: TObject);
procedure SetWidth(AWidth: Integer);
public
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
function GetChildOwner: TComponent; override;
constructor Create(AOwner: TComponent); override;
property Childs: TList<TComponent> read FChilds;
published
property Width: Integer read FWidth write SetWidth;
end;
TClFiltro = class(TFiltro)
private
FFiltros: TFiltros;
protected
procedure SetParent(AParent: TWinControl); override;
public
constructor Create(AOwner: TComponent; AFiltros: TFiltros); reintroduce;
function GetParentComponent: TComponent; override;
function HasParent: Boolean; override;
property Parent: TWinControl write SetParent;
end;
TFiltroItem = class(TCollectionItem)
private
FFiltro: TClFiltro;
protected
function GetDisplayName: String; override;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property Filtro: TClFiltro read FFiltro write FFiltro;
end;
TFiltrosCollection = class(TOwnedCollection)
private
FDesigner: IDesigner;
public
property Designer: IDesigner read FDesigner write FDesigner;
end;
procedure Register;
implementation
uses Dialogs, ClFuncoesBase, Vcl.Graphics, ColnEdit;
procedure Register;
begin
RegisterClass(TClFiltro);
RegisterNoIcon([TClFiltro]);
RegisterComponents('Cl', [TFiltros]);
RegisterComponentEditor(TFiltros, TFiltrosEditor);
end;
{ TFiltroItem }
constructor TFiltroItem.Create(Collection: TCollection);
begin
inherited;
if Assigned(Collection) then
begin
FFiltro := TClFiltro.Create(TFiltros(Collection.Owner).Owner, TFiltros(Collection.Owner));
FFiltro.Name := TFiltrosCollection(Collection).Designer.UniqueName(TClFiltro.ClassName);
FFiltro.Parent := TFiltros(Collection.Owner).FFlowPanel;
FFiltro.Margins.Top := 1;
FFiltro.Margins.Bottom := 1;
FFiltro.AlignWithMargins := True;
//FFiltro.SetSubComponent(True);
end;
end;
destructor TFiltroItem.Destroy;
begin
FFiltro.Free;
inherited;
end;
function TFiltroItem.GetDisplayName: String;
begin
Result := FFiltro.Name;
end;
{ TFiltros }
constructor TFiltros.Create(AOwner: TComponent);
begin
inherited;
FChilds := TList<TComponent>.Create;
// Configurações ScrollBox
Align := TAlign.alRight;
AutoScroll := False;
AutoSize := True;
//Configurações GroupBox
FGroupBox := TGroupBox.Create(Self);
FGroupBox.Parent := Self;
FGroupBox.Caption := ' Fil&tros ';
FGroupBox.Font.Style := [fsBold];
//Configurações FlowPanel
FFlowPanel := TFlowPanel.Create(FGroupBox);
FFlowPanel.Parent := FGroupBox;
FFlowPanel.Top := 15;
FFlowPanel.Left := 2;
FFlowPanel.AutoSize := True;
FFlowPanel.FlowStyle := TFlowStyle.fsRightLeftTopBottom;
FFlowPanel.Caption := '';
FFlowPanel.OnResize := OnFlowPanelResize;
FFlowPanel.BevelOuter := TBevelCut.bvNone;
end;
function TFiltros.GetChildOwner: TComponent;
begin
Result := FFlowPanel;
end;
procedure TFiltros.GetChildren(Proc: TGetChildProc; Root: TComponent);
var I: Integer;
begin
// inherited;
for I := 0 to FChilds.Count - 1 do
Proc(TComponent(FChilds[I]));
end;
procedure TFiltros.OnFlowPanelResize(Sender: TObject);
begin
FGroupBox.Width := FFlowPanel.Width + 4;
FGroupBox.Height := Max(FFlowPanel.Height + 17, Height);
VertScrollBar.Range := FGroupBox.Height;
FWidth := FFlowPanel.Width;
end;
procedure TFiltros.SetWidth(AWidth: Integer);
begin
FFlowPanel.Width := AWidth;
FWidth := FFlowPanel.Width;
OnFlowPanelResize(Self);
end;
{ TFiltrosEditor }
procedure TFiltrosEditor.ExecuteVerb(Index: Integer);
var LCollection: TFiltrosCollection;
I: Integer;
begin
LCollection := TFiltrosCollection.Create(Component, TFiltroItem);
LCollection.Designer := Designer;
for I := 0 to TFiltros(Component).Childs.Count - 1 do
with TFiltroItem.Create(nil) do
begin
FFiltro := TClFiltro(TFiltros(Component).Childs[I]);
Collection := LCollection;
end;
ShowCollectionEditorClass(Designer, TCollectionEditor, Component, LCollection, 'Filtros');
end;
function TFiltrosEditor.GetVerb(Index: Integer): String;
begin
Result := 'Editar filtros...';
end;
function TFiltrosEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
{ TClFiltro }
constructor TClFiltro.Create(AOwner: TComponent; AFiltros: TFiltros);
begin
inherited Create(AOwner);
FFiltros := AFiltros;
end;
function TClFiltro.GetParentComponent: TComponent;
begin
Result := FFiltros;
end;
function TClFiltro.HasParent: Boolean;
begin
Result := Assigned(FFiltros);
end;
procedure TClFiltro.SetParent(AParent: TWinControl);
begin
if Assigned(AParent) then
FFiltros.FChilds.Add(Self)
else
FFiltros.FChilds.Remove(Self);
inherited;
end;
end.
I've finally managed to do it. It required a combination of TOwnedCollection and overriding GetChildren and GetParentComponent.
Basically what I've learned (and you can correct me if I'm wrong), is the following:
For a component to be shown in the Structure tab at all, the Owner of that component has to be the form. So the first thing was to create TFiltro with that owner.
GetParentComponent defines where in the Structure tree the component is going to reside in, it doesn't necessarily have to be the actual parent. So the second thing was to make GetParentComponent of the TFiltro return the TScrollBox but set the actual parent to be the TFlowPanel.
Now, as the parent of TFiltro no longer is the form, it won't save it to the DFM, because TFlowPanel is the actual parent but is not defined as a subcomponent. Overriding GetChildren in the TScrollBox and making it return every TFiltro solves this, and it is now saved in the DFM as a child.
But now, for the TFiltro to be properly read back from the DFM and be set again accordingly, it has to be a published value in an item inside the TOwnedCollection, which itself is a published value in the TScrollBox. Then, make the TCollectionItem published value's set function define the parent of the TFiltro to be the TFlowPanel.
The article which helped me the most in achieving this is available in the WayBack machine.
I try to create a TComboBox like component, inherited from TMaskEdit with a TSpeedButton inside the edit itself.
The problem when I type something into the edit the most of the button disappears (the right and the bottom edge still visible). If I move the mouse over the component or exit using TAB, the button appears again.
Here is the code:
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Mask, Buttons;
type
TMyEdit = class(TCustomMaskEdit)
private
FButton: TSpeedButton;
protected
procedure CreateButton;
public
constructor Create(AOwner: TComponent); override;
procedure CreateWnd; override;
destructor Destroy; override;
end;
implementation
constructor TMyEdit.Create(AOwner: TComponent);
begin
inherited;
CreateButton;
end;
procedure TMyEdit.CreateButton;
begin
FButton := TSpeedButton.Create(Self);
FButton.Parent := Self;
FButton.Align := alRight;
FButton.Width := 16;
FButton.Caption := '';
FButton.Transparent := False;
end;
destructor TMyEdit.Destroy;
begin
FreeAndNil(FButton);
inherited;
end;
procedure TMyEdit.CreateWnd;
begin
inherited;
Perform(EM_SETMARGINS, EC_RIGHTMARGIN, (FButton.Width + 4) shl 16);
end;
What do I miss?
Solved.
WS_CLIPCHILDREN flag have to be included in the CreateParams() AND the button must be placed on TWinControl descendant (TPanel in my case) OR the button itself must be a TWinControl descendant (for example TButton). Graphic controls has no Handle, thats the problem.
Modified code:
procedure TMyEdit.CreateButton;
var
xDrawRect: TRect;
xPanel : TPanel;
begin
xPanel := TPanel.Create(Self);
xPanel.Parent := Self;
xPanel.SetBounds(Width - Height, 0, Height, Height);
xPanel.BevelOuter := bvNone;
FButton := TSpeedButton.Create(Self);
FButton.Parent := xPanel;
FButton.Align := alClient;
FButton.Caption := '';
end;
procedure TMyEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_CLIPCHILDREN;
end;
How can I make a Form (ShowModal) with BorderStyle bsDialog. but one that could still be resized and have the close button (without the Icon,Minimize, Maximize)?
I do not need it to show the size grip.
Here is my solution which seems to work OK:
type
TForm2 = class(TForm)
procedure FormCreate(Sender: TObject);
private
protected
procedure CreateWnd; override;
procedure CreateParams(var Params: TCreateParams); override;
public
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
procedure TForm2.FormCreate(Sender: TObject);
begin
BorderIcons := [biSystemMenu];
BorderStyle := bsSizeable;
AutoScroll := False;
end;
procedure TForm2.CreateWnd;
begin
inherited;
SendMessage(Handle, WM_SETICON, 1, 0);
end;
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE;
end;
IMO, This cant be done with bsDialog but the above feels and looks just like a "bsDialog" which could be resized.
Set the BorderStyle to bsSizeToolWin.
Quick question in regard to Delphi XE.
I'm trying to make a customized circle-shape component that has transparent background, so that when added on a form, the component can overlap other components. I've tried Brush.Style:=bsTransparent; or ellipse() and more on... but still couldn't find a way to make the edge area transparent.
Is there anyway I can make the edge area of the component transparent without using other lib or api?
Well here's a quick answer, that should get you going.
type
TEllipticPanel = class(Vcl.ExtCtrls.TPanel)
procedure CreateWnd; override;
procedure Paint; override;
procedure Resize; override;
procedure RecreateHRGN;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
panl: TEllipticPanel;
public
{ Public declarations }
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
panl := TEllipticPanel.Create(self);
panl.Left := 10;
panl.Top := 10;
panl.Width := 100;
panl.Height := 50;
panl.ParentBackground := False;
panl.ParentColor := False;
panl.Color := clYellow;
panl.Parent := self;
end;
{ TEllipticPanel }
procedure TEllipticPanel.RecreateHRGN;
var
hr: hRgn;
begin
inherited;
hr := CreateEllipticRgn(0,0,Width,Height);
SetWindowRgn(Handle, hr, True);
end;
procedure TEllipticPanel.CreateWnd;
begin
inherited;
RecreateHRGN;
end;
procedure TEllipticPanel.Paint;
begin
inherited;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := TPenStyle(psSolid);
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clGray;
Canvas.Ellipse(1,1,Width-2,Height-2);
end;
procedure TEllipticPanel.Resize;
begin
inherited;
RecreateHRGN;
end;
The key is the Windows CreateEllipticRgn and the GDI SetWindowRgn functions.
For more information about windows regions see Regions.
I have created a custom control TOuterControl that is the parent for multiple TInnerControls.
Everything is working fine except that the IDE is creating icons for each the child TInnerControl's (InnerControl1 and InnerControl2 in the screenshot). How do I prevent the IDE from generating the icons?
unit TestControl;
interface
Procedure Register;
implementation
Uses
Classes,
Controls,
SysUtils,
DesignEditors,
DesignIntf,
VCLEditors;
Type
TOuterControl = Class;
TInnerControl = Class(TComponent)
Protected
FOuterControl : TOuterControl;
function GetParentComponent: TComponent; Override;
Function HasParent : Boolean; Override;
procedure SetParentComponent (Value: TComponent); Override;
End;
TOuterControl = Class(TCustomControl)
Protected
FInnerControls : TList;
Procedure Paint; Override;
Public
Constructor Create(AOwner : TComponent); Override;
Procedure AddInnerControl(AInnerControl : TInnerControl);
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
End;
TOuterControlEditor = Class(TDefaultEditor)
Public
Procedure ExecuteVerb(Index : Integer); Override;
Function GetVerb (Index : Integer) : String; Override;
Function GetVerbCount : Integer; Override;
End;
procedure TOuterControl.AddInnerControl(AInnerControl: TInnerControl);
begin
AInnerControl.FOuterControl := Self;;
FInnerControls.Add(AInnerControl);
Invalidate;
end;
constructor TOuterControl.Create(AOwner: TComponent);
begin
inherited;
FInnerControls := TList.Create;
end;
procedure TOuterControl.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
I : Integer;
begin
inherited;
For I := 0 To FInnerControls.Count - 1 Do
Proc(FInnerControls[I]);
end;
procedure TOuterControl.Paint;
begin
inherited;
Canvas.FillRect(ClientRect);
Canvas.TextOut(0,0, Format('Inner Control Count = %d', [FInnerControls.Count]));
end;
function TInnerControl.GetParentComponent: TComponent;
begin
Result := FOuterControl;
end;
function TInnerControl.HasParent: Boolean;
begin
Result := True;
end;
procedure TInnerControl.SetParentComponent(Value: TComponent);
begin
If Value Is TOuterControl Then
If FOuterControl <> Value Then
Begin
FOuterControl := TOuterControl(Value);
FOuterControl.AddInnerControl(Self);
End;
end;
procedure TOuterControlEditor.ExecuteVerb(Index: Integer);
Var
OuterControl : TOuterControl;
InnerControl : TInnerControl;
begin
inherited;
OuterControl := TOuterControl(Component);
If Index = 0 Then
Begin
InnerControl := TInnerControl.Create(OuterControl.Owner);
OuterControl.AddInnerControl(InnerControl);
End;
end;
function TOuterControlEditor.GetVerb(Index: Integer): String;
begin
Result := 'Add Inner';
end;
function TOuterControlEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
Procedure Register;
Begin
RegisterComponents('AA', [TOuterControl]);
RegisterComponentEditor(TOuterControl, TOuterControlEditor);
End;
Initialization
Classes.RegisterClasses([TInnerControl]);
end.
You can prevent them from appeaing on the form with:
RegisterNoIcon([TInnerControl]);
More info on RegisterNoIcon can be found at http://docwiki.embarcadero.com/VCL/e/index.php/Classes.RegisterNoIcon
It's a little confusing having classes with a name that end with "Control" that aren't normal visual controls though.
If TInnerControl is meant to be used only inside a TOuterControl, then you should call SetSubComponent(True) during/after the TInnerControl's creation.
When you create the inner controls, you tell them that their owner is the form (the owner of the outer control). Therefore, the form draws them, just like it draws all the other components it owns. You probably want the outer control to own the inner ones.