Lazarus Nongraphical Visual Component Example Code

From Free Pascal wiki
Jump to navigationJump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

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:

myvisualcomponent properties11.png

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
= 17) Filename property with custom properties for the OpenDialog
=
= 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.1'; // 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
  tFilenameString = string; // Unique string type used in MyFilename 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
    fFileNameString: tFilenameString; // Filename
    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)
    Note: Comments immediately above the property declarations are displayed in the Lazarus Object Inspector lower pane
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

    // Example of a file open dialog property
    property MyFilename: tFilenameString read fFilenameString write fFilenameString;

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

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

    // ReadOnly property
    property Version: string read fVersion;

    // 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;
  // Declaration for 'MyFilename' property editor
  // (See PropEdits unit for a list of property editors to modify)
  TMyFileNamePropertyEditor = class(TFileNamePropertyEditor)
  public
    // Override the Edit method for total control
    function GetFilter: string; override;
    function GetDialogOptions: TOpenOptions; override;
    function GetDialogTitle: string; override;
  end;

procedure Register; // Must be declared here just before implementation

implementation

procedure Register;
begin
  {$I myvisualcomponent_icon.lrs}
  // Register this component into the IDE on the 'Additional' component palette
  RegisterComponents('Additional', [TMyVisualComponent]);

  // Register the custom property editor for the 'About' property
  RegisterPropertyEditor(TypeInfo(tAboutString),
    TMyVisualComponent, 'About', TAboutPropertyEditor);
  // Register the custom property editor for the 'MyFilename' property
  RegisterPropertyEditor(TypeInfo(tFilenameString),
    TMyVisualComponent, 'MyFilename', TMyFileNamePropertyEditor);

  // Note the TypeInfo parameter is made into a unique string type
  // (defined earlier in this unit)
  // so that the regular property editors in other components don't get confused
  // You could simply use TypeInfo(String)
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 ==
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;

function TMyFileNamePropertyEditor.GetFilter: string;
begin
  Result := 'All Files|*.*|Bitmaps|*.bmp|JPegs|*.jpg';
end;

function TMyFileNamePropertyEditor.GetDialogOptions: TOpenOptions;
begin
  // To see the full list, drop an OpenDialog onto a form and see the Options property
  Result := [ofFileMustExist, ofPathMustExist];
end;

function TMyFileNamePropertyEditor.GetDialogTitle: string;
begin
  Result := 'My Custom Title';
end;
// == END PROPERTY EDITOR CODE ==

// == 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

See also