I'm writing a component that include few components.
TMyComponent = class(TPanel)
private
fGrid : TExCustomDBGrid;
fOnCellClick : TDBGridClickEvent;
public
constructor Create(AOwner: TComponent); override;
published
property OnCellClick: TDBGridClickEvent read FOnCellClick write FOnCellClick;
End;
...
constructor TMyComponent .Create(AOwner: TComponent);
begin
inherited;
fGrid := TExCustomDBGrid.Create(self);
fGrid.parent := self;
fGrid.Align := alClient;
end;
I want to be able to propagate the Event from the component (TPanel), to the fGrid included.
How can I reach that goal ?
I guess I should declare an Event with the same type on the TPanel (as container component). Then how to propagate into the fGrid ?
It's a bit unclear what you're asking, but based on the code I see, write an event handler and assign it to the grid...
procedure TMyComponent.DBGridCellClicked(Column: TColumn);
begin
if Assigned(fOnCellClick) then
fOnCellClick(Column);
end;
constructor TMyComponent.Create(AOwner: TComponent);
begin
inherited;
fGrid := TExCustomDBGrid.Create(self);
fGrid.Parent := self;
fGrid.Align := alClient;
fGrid.OnCellClick := DBGridCellClicked;
end;
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 want to have a custom StringGrid element.
I created a class:
type
TClassStringGrid = class(TCustomControl)
...
with
constructor TClassStringGrid.Create(AOwner: TForm);
begin
inherited Create(nil);
myGroupBox1 := TGroupBox.Create(AOwner);
myGroupBox1.Parent := AOwner;
myStringGrid1 := TStringGrid.Create(self);
myStringGrid1.Parent := myGroupBox1;
myStringGrid1.Options := myStringGrid1.Options + [goEditing];
end;
destructor TClassStringGrid.Destroy;
begin
if myStringGrid1 <> nil then begin
FreeAndNil(myStringGrid1);
end;
if myGroupBox1 <> nil then begin
DestroyComponents;
FreeAndNil(myGroupBox1);
end;
// Call the parent class destructor
inherited;
end;
I created a class in Form1 and show it. It works. But if I put some value into the StringGrid (Form1) and then try to close Form1 I get an exception "the element has no parent window" in FreeAndNil(myStringGrid1);.
What is wrong by Destroy?
I would be thankfull for any information you can provide me.
Assuming you want to show a String grid in a Group box on this control, then this is how it should look like:
type
TMyStringGrid = class(TCustomControl)
private
FGroupBox: TGroupBox;
FStringGrid: TStringGrid;
public
constructor Create(AOwner: TComponent); override;
end;
constructor TMyStringGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FGroupBox := TGroupBox.Create(Self);
FGroupBox.Parent := Self;
FStringGrid := TStringGrid.Create(Self);
FStringGrid.Parent := FGroupBox;
end;
In this manner, your newly designed control is owner and parent of the sub controls. Destruction is done automatically because of that.
I have created a component descended from TPanel. In the constructor of the component I create several TButton components. I have created and surfaced a ButtonFont property of type TFont. This property controls the font of all the buttons on the component. Example:
TMyPanel = Class(TPanel)
private
FButtonFont : TFont;
FExampleButton : TButton;
procedure SetButtonFont(Value: TFont);
public
property ButtonFont: TFont read FButtonFont write SetButtonFont;
constructor Create (AOwner: TComponent); override;
end;
constructor TMyPanel.Create (AOwner: TComponent);
begin
FButtonFont := TFont.Create;
FExampleButton := TButton.Create(self);
FExampleButton.Parent := self;
.......
inherited;
end;
procedure TMyPanel.SetButtonFont(Value: TFont);
begin
FButtonFont.Assign(Value);
FExampleButton.Font := Value;
end;
The following will cause all subclassed buttons have their button font changed:
MyLabel.Font.Size := 22;
MyPanel.ButtonFont := label1.font;
I can see the SetButtonFont method is being called.
How can I get something like this to cause all subclassed buttons to change their font size:
MyPanel.ButtonFont.Size := 22;
Assign a handler to the font's OnChange event and update all the sub-controls' fonts in that handler:
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited;
FButtonFont := TFont.Create;
FButtonFont.OnChange := ButtonFontChanged; // <-- here
FExampleButton := TButton.Create(Self);
FExampleButton.Parent := Self;
...
end;
destructor TMyPanel.Destroy;
begin
...
FButtonFont.Free;
inherited;
end;
procedure TMyPanel.ButtonFontChanged(Sender: TObject);
begin
FExampleButton.Font := FButtonFont;
...
end;
I am trying to do simple thing: Add a Canvas property on the TScrollBox descendant. I have read this article
but my ScrollBox descendant simply does not draw on the canvas. May anybody tell me, what is wrong?
TfrmScrollContainer = class (TScrollBox)
private
FCanvas: TCanvas;
FControlState:TControlState;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Paint;
procedure PaintWindow(DC: HDC); override;
property Canvas: TCanvas read FCanvas;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
... this is exact copy, how TWincontrol turns to TCustomControl (but it fails somewhere)
constructor TfrmScrollContainer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;
destructor TfrmScrollContainer.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end;
procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
Include(FControlState, csCustomPaint);
inherited;
Exclude(FControlState, csCustomPaint);
end;
procedure TfrmScrollContainer.PaintWindow(DC: HDC);
begin
FCanvas.Lock;
try
FCanvas.Handle := DC;
try
TControlCanvas(FCanvas).UpdateTextFlags;
Paint;
finally
FCanvas.Handle := 0;
end;
finally
FCanvas.Unlock;
end;
end;
procedure TfrmScrollContainer.Paint; // this is not executed (I do not see any ellipse)
begin
Canvas.Brush.Color:=clRed;
Canvas.Ellipse(ClientRect);
end;
Thanx
You are not including csCustomPaint to ControlState, you're including it to the similarly named field you declared. Your field is not checked, the ascendant control does not know anything about it. To solve, replace
procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
Include(FControlState, csCustomPaint);
inherited;
Exclude(FControlState, csCustomPaint);
end;
with
procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
ControlState := ControlState + [csCustomPaint];
inherited;
ControlState := ControlState - [csCustomPaint];
end;
Alternatively your scroll box may parent any control for your custom painting to work. The inherited WM_PAINT handler checks to see the control count and if it's not 0 it calls the paint handler instead of delivering the message to the default handler.
I'm hoping to create something like a "TOwnedStringList" (class name is a fiction) that I could construct as:
sl := TOwnedStringList.Create(Self);
sl.Sorted := True;
sl.Duplicates := dupIgnore;
sl.Add(...);
// etc...
Where Self could be a Form (for example), so that the Owner will auto free the StringList.
I want to be able to avoid calling sl.Free myself.
Is This possible?
That's going to be a little messy. You'd need to do something like this.
type
TOwnerComponent = class(TComponent)
private
FOwnedObject: TObject;
public
constructor Create(Owner: TComponent; OwnedObject: TObject);
destructor Destroy; override;
end;
TOwnedStringList = class(TStringList)
private
FOwner: TOwnerComponent;
public
constructor Create(Owner: TComponent);
destructor Destroy; override;
end;
{ TOwnerComponent }
constructor TOwnerComponent.Create(Owner: TComponent; OwnedObject: TObject);
begin
inherited Create(Owner);
FOwnedObject := OwnedObject;
end;
destructor TOwnerComponent.Destroy;
begin
FOwnedObject.Free;
inherited;
end;
{ TOwnedStringList }
constructor TOwnedStringList.Create(Owner: TComponent);
begin
inherited Create;
if Assigned(Owner) then
FOwner := TOwnerComponent.Create(Owner, Self);
end;
destructor TOwnedStringList.Destroy;
begin
if Assigned(FOwner) and not (csDestroying in FOwner.ComponentState) then
begin
FOwner.FOwnedObject := nil;
FOwner.Free;
end;
inherited;
end;
Basically you create an instance of TOwnerComponent that is owned by the Owner that you pass to TOwnedStringList.Create. When that Owner dies, it destroys the TOwnerComponent which in turn destroys your string list.
The code is resilient to an explicit Free being called on the string list.