Lazarus Nongraphical Visual Component Example Code

Introduction

There are many property types in Lazarus, and when writing a descendent of TComponent it is not always straightforward how to implement some of them. After searching many sources I have written a component template that includes most property types.

The code below is a working component that could be packaged and compiled in the IDE, but its purpose is to serve as a source of copy/paste snippets.

Here's what it looks like in the Lazarus Object Inspector:

Code to copy and paste

unit MyCustomControl;

{
= Example of a generic non-graphical component for Lazarus 1.x
= - example code for various types of properties and events to show and act correctly in the Object Inspector
= - including a custom 'About' dialog property editor
=
= Although this unit will compile as written, the purpose is to provide template code
= for various property types and events that can be copy/pasted into your own component
=
= Example Property types:
=  1) Bitmap
=  2) Font
=  3) Icon
=  4) Stringlist
=  5) Options expandable true/false list
=  6) User type drop-down list
=  7) Simple String
=  8) String with pre and post-processing
=  9) String Array with indexed properties
= 10) String with default value
= 11) Integer with default value
= 12) Overridden (custom) Tag property
= 13) Inherited drop-down list of types
= 14) Custom dialog
= 15) Custom events
= 16) Property hidden from the Object Inspector
=
= Author: minesadorada@charcodelvalle.com
= Date: May 2014
= License: LGPL
=
}
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Buttons,
  LCLIntf, LCLType, LResources,
  ExtCtrls, StdCtrls, Dialogs, PropEdits;

const
  C_VERSION = '1.0'; // Remember to co-ordinate with the Package manager VersionInfo

  C_ERRORMESSAGE = '%s error:' + LineEnding + '%s';
// Used with Exception.CreateFmt

type
  // Drop-down list in Object Inspector
  tmcType = (mcType1, mcType2, mcType3);

  // Expandable list of Options in Object Inspector
  tOptions = (Opt1, Opt2, Opt3);
  tOptionsFlags = set of tOptions;

  tAboutString = string; // Unique string type used in 'About' property editor

  TSampleEvent = procedure(MyText: string) of object;  // Custom Event type

  TMyVisualComponent = class(TComponent) // Non-graphical ancestor
  private
    { Private declarations }
    fAboutString: string; // Dummy string for 'About' property
    fmcType: tmcType; // Type defined above
    fSimpleString: string; // Direct read and write (no methods)
    fProcessedString: string; // Methods used to read and write the property
    fStringWithDefault: string; // Object Inspector shows default
    fIntegerWithDefault: integer; // Object Inspector shows default
    fTag: string; // Property overrides normal Tag property
    fOptions: tOptionsFlags; // Variable of Set type. * If Opt1 IN fOptions then...
    fIcon: TIcon; // Assigned to Application Icon by default
    fFont: TFont; // Assigned only if MyFont property set
    fBitMap: TBitMap; // Assigned only if MyBitmap property set
    fSizeConstraints: TSizeConstraintsOptions;
    // Built-in set (part of TSizeConstraints object)
    fStringArray: array[0..3] of string;
    // Stores values of String1,String2,String3 and String4 properties
    fStringList: TStrings; // Holds MyStringList property values
    fVersion: string; // Holds read-only version property
    FOnSample: TSampleEvent; // Custom event

    fHiddenString: string; // Hidden property
    fOnChangeHiddenString: TNotifyEvent; // Custom event

    { Private methods }

    procedure SetProcessedString(AValue: string);
    function GetProcessedString: string;
    // Read and Write procedures for property ProcessedString

    procedure SetTag(AValue: string); // Write procedure for overridden property 'Tag'

    function GetStringValue(const AIndex: integer): string;
    // Indexed Get Method
    procedure SetStringValue(const AIndex: integer; AValue: string);
    // Indexed Set method

    procedure SetStrings(const AValue: TStrings);
    // Needed to use a TStrings property.  FStringList also needs to be created in the Constructor

    procedure SetFont(const AValue: TFont);
    // Needed to use a Font property. fFont also needs to be created in the Constructor

    procedure SetBitMap(const AValue: TBitmap);
    // Needed to use a BitMap property. fBitMap also needs to be created in the Constructor

    // Sets the HiddenString property
    procedure SetHiddenString(const AValue: string);
  protected
    { Protected declarations }
    // Can be used if you plan to subclass this component
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override; // Constructor must be public
    destructor Destroy; override; // Destructor must be public

    { Public properties }
    // This section used for properties you don't want to display in the Object Inspector (or array properties)
    property HiddenString: string read fHiddenString write SetHiddenString;
    // Public property hidden from the Object Inspector. * SetHiddenString method can trigger custom event OnChangeHiddenString
  published
    { Published declarations (Displayed in the Object Inspector)}

    property About: tAboutString read fAboutString; // Example of custom 'About' dialog
    // The custom property editor TAboutPropertyEditor is used in the Object Inspector

    property MyTypeList: tmcType read fmcType write fmcType default mcType2;
    // Example of drop-down list in the Object Inspector
    // Default is displayed in different font but has to be set in Constructor

    property SimpleString: string read fSimpleString write fSimpleString;
    // Direct access read + write

    property ProcessedString: string read GetProcessedString write SetProcessedString;
    // Example of using Read and Write methods

    property StringWithDefault: string read fStringWithDefault write fStringWithDefault;
    // Example of pseudo-default property of a string (value is set in Constructor)

    property Options: tOptionsFlags read fOptions write fOptions;
    // Example of an expandable list of booleans in the Object Inspector

    property MyIcon: TIcon read fIcon write fIcon;
    // Browse for Icon dialog in the Object Inspector. * No need to Create fIcon in constructor

    property MyFont: TFont read fFont write SetFont; // * Note the SetFont method
    // Browse for Font dialog in the Object Inspector. * fFont needs to be created in Constructor

    property MyBitMap: TBitmap read fBitMap write SetBitmap;
    // * Note the SetBitmap method
    // Browse for Bitmap dialog in the Object Inspector. * fBitmap needs to be created in Constructor

    property MySizeConstraints: TSizeConstraintsOptions
      read fSizeConstraints write fSizeConstraints;
    // Showing a built-in list of booleans in the Object Inspector

    property IntegerWithDefault: integer read fIntegerWithDefault
      write fIntegerWithDefault default 2; // Example of integer default
    // Default is displayed in different font but has to be set to the value 2 in Constructor

    // Example of using an indexed read and write method to store strings in an array
    // The method is passed the index as a parameter
    property String1: string index 1 read GetStringValue write SetStringValue;
    property String2: string index 2 read GetStringValue write SetStringValue;
    property String3: string index 3 read GetStringValue write SetStringValue;
    property String4: string index 4 read GetStringValue write SetStringValue;

    property MyStringList: TStrings read fStringList write SetStrings;
    // String list example.
    // Dialog shows in the Object Inspector. * fStringlist must be Created in the constructor.  * Note the SetStrings override

    // Example of overriding an ancestor (TComponent's) Tag property
    // Tag property will now only accept a single alpha character
    property Tag: string read fTag write SetTag;

    // Example of publishing a public property from an ancestor (TComponent)
    // No need to specify type, read method or write method
    property ComponentState;

    property Version: string read fVersion; // ReadOnly property

    // Example of Custom Event that does nothing
    property OnSample: TSampleEvent read FOnSample write FOnSample;

    // This custom event is always triggered by a change in the value of HiddenString property
    property OnChangeHiddenString: TNotifyEvent
      read fOnChangeHiddenString write fOnChangeHiddenString;
  end;

  // Declaration for the 'About' property editor
  TAboutPropertyEditor = class(TClassPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
  end;

procedure Register; // Must be declared here

implementation

procedure Register;
begin
  {$I myvisualcomponent_icon.lrs}
  // Register the custom property editor for the 'About' property
  RegisterPropertyEditor(TypeInfo(tAboutString),
    TMyVisualComponent, 'About', TAboutPropertyEditor);

  // Register this component into the IDE on the 'Additional' component palette
  RegisterComponents('Additional', [TMyVisualComponent]);
end;

constructor TMyVisualComponent.Create(AOwner: TComponent);
  // Called when form is loaded into the IDE
begin
  inherited Create(AOwner);
  // Initialisation goes here
  // Set any properties to their defaults and intialise objects
  fmcType := mcType2; // because this was the default value specified
  fStringWithDefault := 'Default String'; // Unspecified default
  fIntegerWithDefault := 2; // Default value specified
  fTag := 'A'; // Unspecified default
  fIcon := Application.Icon; // Unspecified default
  fFont := TFont.Create; // Needs to be created here for Object Inspector to show options
  fBitmap := TBitMap.Create;
  // Needs to be created here for Object Inspector to show the bitmap dialog
  fStringList := TStringList.Create;
  // Needs to be created here for Object Inspector to show dialog
  fVersion := C_VERSION;
  // Assign read-only property
end;

destructor TMyVisualComponent.Destroy;
begin
  // Clean-up code goes here
  // FreeandNil any user-created objects here
  FreeAndNil(fBitmap);
  FreeAndNil(fStringList);
  FreeAndNil(fFont);
  inherited Destroy;
end;


// == START PROPERTY EDITOR CODE FOR About PROPERTY ==
procedure TAboutPropertyEditor.Edit;
// Shows a dialog when About property is double-clicked
var
  tAboutForm: TForm;
  OKbutton: TBitBtn;
  lbl_Description: TLabel;
  sz: string;
begin
  // Make up message string
  sz := 'My component for Lazarus' + LineEnding + 'by email@domain.com' +
    LineEnding + LineEnding;
  sz += 'Methods:' + LineEnding;
  sz += 'MyVisualComponent.Method1' + LineEnding;
  sz += 'MyVisualComponent.Method2' + LineEnding;
  sz += LineEnding + 'Version: ' + C_VERSION + LineEnding;
  sz += 'License: LGPL';
  // Create a new dialog
  tAboutForm := TForm.CreateNew(nil);
  try  //.. finally FreeAndNil everything
    with tAboutForm do
    begin
      // Set Form properties
      position := poScreenCenter;
      borderstyle := bsToolWindow;
      Caption := 'About My Component';
      formstyle := fsSystemStayOnTop;
      color := clSkyBlue;
      Height := 240;
      Width := 320;
      // Create a BitBtn button
      okbutton := TBitBtn.Create(tAboutForm);
      // Set BitBtn properties
      okbutton.Kind := bkClose;
      okbutton.left := (Width div 2) - okbutton.Width div 2;
      okbutton.top := Height - okbutton.Height - 10;
      okbutton.parent := tAboutForm;
      // Create a label control
      lbl_Description := Tlabel.Create(tAboutForm);
      // Set label properties
      lbl_Description.left := 8;
      lbl_Description.Top := 30;
      lbl_Description.Width := 304;
      lbl_Description.Height := 200;
      lbl_Description.Autosize := False;
      lbl_Description.Alignment := taCenter;
      lbl_Description.Caption := sz;
      lbl_Description.parent := tAboutForm;
      // Display the dialog modally
      ShowModal;
    end;
  finally
    // Free all resources
    FreeAndNil(lbl_Description);
    FreeAndNil(okbutton);
    FreeAndNil(tAboutForm);
  end;
end;

function TAboutPropertyEditor.GetAttributes: TPropertyAttributes;
  // Show the ellipsis
begin
  Result := [paDialog];
end;

function TAboutPropertyEditor.GetValue: string;
  // Override standard string read method
begin
  Result := '(Double-click)';
end;
// == END PROPERTY EDITOR CODE FOR About PROPERTY ==

// == PROPERTY GET/SETS ==
procedure TMyVisualComponent.SetProcessedString(AValue: string);
begin
  // Check to see if a change is necessary
  // Avalue can be amended before it is assigned to fProcessedString
  if (fProcessedString <> AValue) then
    fProcessedString := UpperCase(AValue);
end;

function TMyVisualComponent.GetProcessedString: string;
begin
  // Do any error-checking or processing of fProcessedString here.
  Result := fProcessedString;
end;

procedure TMyVisualComponent.SetTag(AValue: string);
// Overridden Tag property will only accept letters
// If changed via Object Inspector to a non-alpha string, then show custom error message
begin
  if (fTag <> AValue) and (Length(AValue) > 0) then
    if AValue[1] in ['A'..'Z'] + ['a'..'z'] then
      fTag := AValue[1]
    else
    if ComponentState = [csDesigning] then
      raise Exception.CreateFmt(C_ERRORMESSAGE,
        [Name, 'You can only set the tag property to an alpha value']);
  // 'Name' is the Name property of this TComponent instance
end;

function TMyVisualComponent.GetStringValue(const AIndex: integer): string;
begin
  // Example of an indexed property Get method
  // Retrieve from private string Array
  Result := fStringArray[AIndex - 1];
end;

procedure TMyVisualComponent.SetStringValue(const AIndex: integer; AValue: string);
// Example of an indexed property Set method
// Value is stored in private string array
begin
  if (fStringArray[AIndex - 1] <> AValue) then
    fStringArray[AIndex - 1] := AValue;
end;

procedure TMyVisualComponent.SetStrings(const AValue: TStrings);
begin
  // this is correct statement
  FStringList.Assign(AValue);
  // this is not correct
  // FStrings := AValue;
end;

procedure TMyVisualComponent.SetFont(const AValue: TFont);
begin
  // this is correct statement
  fFont.Assign(AValue);
  // this is not correct
  // fFont := AValue;
end;

procedure TMyVisualComponent.SetBitMap(const AValue: TBitmap);
begin
  // this is correct statement
  fBitmap.Assign(AValue);
  // this is not correct
  // fBitmap := AValue;
end;

procedure TMyVisualComponent.SetHiddenString(const AValue: string);
// If value is changed then triggers the custom events OnChangeHiddenString and OnSample
begin
  if (fHiddenString <> AValue) then
  begin
    fHiddenString := AValue;
    // Trigger custom events
    if Assigned(fOnChangeHiddenString) then
      OnChangeHiddenString(Self);
    if Assigned(fOnSample) then
      OnSample(AValue);
  end;
end;
// Sample application code that uses the Custom Events as coded
// Both are triggered by changing the HiddenString property in SetHiddenString
{
procedure TForm1.MyVisualComponent1ChangeHiddenString(Sender: TObject);
begin
  ShowMessage('Hidden String was changed to something new');
end;

procedure TForm1.MyVisualComponent1Sample(MyText: String);
begin
  ShowMessageFmt('Hidden String was changed to "%s"',[MyText]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyVisualComponent1.HiddenString:='Hello World';
end;
}
end.

Download

You can download this code as a package ready to install and play with here

Author

minesadorada@charcodelvalle.com

License

All code is released under the LGPL license