Give Your Clients Control of the GUI (Delphi Developer)

Give Your Clients Control of the GUI

Steve Zimmelman

How many times have you delivered what you thought was a completed application, only to hear your client say, "Gee, this is nice, but I'd really like the Name on the left, and the Status field should be red, not black, and . . ." Wouldn't it be nice if all your users had to do was right-click the mouse over the control, and up comes a popup menu allowing them to change the control's attributes? Or if they press Ctrl-ArrowKey or Shift-ArrowKey to change the position or size of the control?

Giving users control of the GUI is a two-step process. First you have to create controls with properties users can change at runtime, and then you must have a way to save and restore the changes. Usually, the control that gets the most use is the DBEdit. So this example will focus on creating a DBEdit that uses a customized PopupMenu that's activated on the right-click of the mouse. The menu will allow the user to change Color, Font, Tab Order, and Text Case. Additionally, the key combination of Ctrl-Arrow and Shift-Arrow will change the position and size of the control, respectively.

Before I begin, I want to introduce you to a new text-case property: ProperCase. Most proper-case conversions usually capitalize only the first letter, then any letter that follows a space. But this leaves a host of names and abbreviated titles looking a bit awkward, like McDonald, O'Hara, M.D., and so forth. So in my attempt to create a better mouse-trap, I included a proper-case conversion that has the intelligence to handle these special names. I placed the functions used for the proper-case conversion in a unit called StrFunc.pas and then included the unit StrFunc in the Uses statement of the component.

Creating the changeable DBEdit
The first thing I did was create a new component using TDBEdit as the parent class. I called the new class TPSIDBEdit because the name of the company I work for is PSI, and it was a simple way to distinguish the component. Next I created a new CharCase type that includes ProperCase. It will be used to override the DBEdit's TCharCase. I also changed the CharCase property to a new type, TPSICharCase. In addition to overriding the CharCase property, I introduced two new properties: AllowUserChange and PopupChangeMenu. The property AllowUserChange is a simple Boolean switch that engages or disengages the user's ability to change any of the component's properties at runtime, and PopupChangeMenu is a pointer to the PopupMenu that's in effect when AllowUserChange is set to True. A bulk of the component's changing is actually done by the PopupChangeMenu, but I'll discuss that a little later. Listing 1 presents the PSIDBEdit unit.

Listing 1. The PSIDBEdit unit.

unit PSIDBEdit;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, Dialogs,
  DBCtrls, Menus, db, StrFunc;

type

  TPSICharCase = (ecNormal, ecUpperCase, 
                  ecLowerCase, ecProperCase);
  TPSIDBEdit = class(TDBEdit)
  private
    fCharCase        : TPSICharCase ;
    fIsChanging      : Boolean ;
    fAllowUserChange : Boolean ;
    fStartMove       : Boolean ;
    fTop             : Integer ;
    fLeft            : Integer ;
    fChangeMenu      : TpopupMenu ;
    fPopupSave       : TPopupMenu ;

    Procedure SetAllowUserChange(Value:Boolean);
    Procedure SetChangeMenu(Value:TpopupMenu) ;
    Procedure SetPopUpMenu ;

    Procedure SetCharCase(Value:TPSICharCase);
    Procedure SetTextCase(Const bCheckState:Boolean) ;
  protected
  public
    Procedure Loaded ; Override ;
    Procedure Change ; Override ;
    procedure KeyDown(var Key: Word; 
                      Shift: TShiftState); override;
    Procedure MouseDown(Button: TMouseButton; Shift: 
                        TShiftState; X, Y: Integer);
                        Override ;
    procedure MouseMove(Shift: TShiftState; 
                        X, Y: Integer); Override;
    procedure MouseUp(Button: TMouseButton; Shift: 
                      TShiftState; X, Y: Integer); 
                      Override;

  published
    Property AllowUserChange : Boolean
             Read fAllowUserChange
             Write SetAllowUserChange ;

    Property CharCase : TPSICharCase
             Read fCharCase
             Write SetCharCase ;

    Property PopupChangeMenu : TPopupMenu
             Read fChangeMenu
             Write SetChangeMenu ;
  end;

I wanted the component to have two states: a default state, which would behave like its ancestor, and a design state, which would allow the user to change its properties at runtime. The Boolean property AllowUserChange distinguishes these two states. When AllowUserChange is True, the component's PopupMenu is changed to point to the value stored in the PopupChangeMenu property. If it's False, then the PopupMenu property reverts to its previous design time assignment. It also allows the component to be moved or resized. I thought it would be nice for the user to be able to see a difference between the two states, so I changed the cursor to crHandPoint (-21) in the SetAllowUserChange method.

The PopupMenu assignment is changed via the SetPopupMenu method when the AllowUserChange property is changed.

In order to swap the PopupMenu pointers, the default PopupMenu is stored in fPopupSave in the Loaded method (see Listing 2). Then the SetPopupMenu method is called to ensure that the proper popup menu is assigned based on the value of AllowUserChange.

Listing 2. The Loaded method.

Procedure TPSIDBEdit.Loaded;
Begin
   Try
      If (csDesigning in ComponentState) Then Exit ;

      // Capture PopupMenu Assignment
      fPopupSave := PopupMenu ;
      SetPopupMenu ;
   Finally
      inherited Loaded;
   End;
End;

With the advent of the new text case ProperCase and the new type TPSICharCase, I had to completely override and re-implement all of the other standard text-case conversions in the Change method of the component (see Listing 3).

Listing 3. The Change method.

Procedure TPSIDBEdit.Change ;
Var
   iSelStart : Integer ;
Begin
   Try
      If (csDesigning in ComponentState)
                          Or fIsChanging Then Exit ;
      // Capture Cursor Position
      iSelStart := SelStart ;
      SetTextCase(False) ;
      // Restore Cursor Position
      SelStart := iSelStart ;
   Finally
      Inherited  ;
   End;
End;

The actual changing of the Text was a little tricky. If you change the text programmatically when the object has focus, and the DataSet isn't in Edit or Insert mode, then the exception "Dataset not in Edit or Insert mode" is generated. So before changing the text, the component's DataSet.State must be interrogated and changed if necessary. We must also handle any potential multi-user conflicts that might occur. The parameter bCheckState is used to determine whether the DataSet.State needs to be placed in Edit or Insert mode before changing the text. If it does, then the method must also Post the changes. The Post method is called only if the memory variable bPost is set to True. Listing 4 shows where all this happens in the SetTextCase method.

Listing 4. The SetTextCase method.

Procedure TPSIDBEdit.SetTextCase(Const bCheckState:
                                 Boolean) ;
Var
   bPost : Boolean ;

   Function CanChange : Boolean ;
   Begin
      Try
         If Not bCheckState Then Begin
            Result := True ;
            Exit ;
         End;
         If (DataSource <> Nil) Then Begin
            If Not (DataSource.DataSet.State
                  In [dsEdit, dsInsert]) Then Begin
               If DataSource.DataSet.Active Then Begin
                  DataSource.DataSet.Edit ;
                  bPost := True ;
               End;
            End;
         End;
         Result := True ;
      Except
         Result := False ;
      End;
   End;

Begin
   // If the Text changes and the DataSet
   // is not in EditState, then an Exception
   // is generated.  Make sure DataSet is
   // in EditState before changing Text.
   fIsChanging := True ;
   Try
      bPost := False ;
      If CanChange Then Begin
         Case CharCase Of
            ecNormal    : {Do Nothing} ;
            ecUpperCase : Text := UpperCase(Text) ;
            ecLowerCase : Text := LowerCase(Text) ;
            ecProperCase: Text := ToProper(Text);
         End;

         If bPost Then
            DataSource.DataSet.Post ;
      End Else
         MessageDlg('Another user may be using this '+
                    'record.'+#13+#13+
                    'TextCase changes may not be '+
                    'visible for this record.' ,
                     mtWarning,[mbOK],0);
   Finally
      fIsChanging := False ;
   End;
End;

Changing the CharCase property executes the SetCharCase method (see Listing 5), which, in turn, executes the SetTextCase method.

Listing 5. The SetCharCase method.

Procedure TPSIDBEdit.SetCharCase(Value:TPSICharCase);
Begin
   If fCharCase <> Value Then Begin
      fCharCase := Value ;
      SetTextCase(True) ;
   End;
End;

In order for the control to have movement capabilities, I overrode the KeyDown method (see Listing 6). Borrowing the Delphi IDE keystrokes for component moving and sizing, I used the Ctrl-ArrowKeys for movement and the Shift-ArrowKeys for sizing. Pressing these keys causes the control to change its size or position by one pixel.

Listing 6. The KeyDown method.

Procedure TPSIDBEdit.KeyDown(var Key: Word; 
                             Shift: TShiftState);
Begin
   If (Key in [vk_up,vk_down,vk_left,vk_right])
                 And AllowUserChange Then Begin
      If (Shift = [ssCtrl]) Then Begin
         // Change position
         Case Key Of
            vk_Up   :  Top  := Top - 1;
            vk_Down :  Top  := Top + 1;
            vk_Left :  Left := Left - 1;
            vk_Right:  Left := Left + 1 ;
         End;
      End Else If (Shift = [ssShift]) Then Begin
         // Change Size
         Case Key Of
            vk_Up   :  Height := Height - 1;
            vk_Down :  Height := Height + 1;
            vk_Left :  Width  := Width - 1;
            vk_Right:  Width  := Width + 1 ;
         End;
      End;
      Key := 0 ;
   End Else Begin
      inherited KeyDown(Key,Shift);
   End;
End;

I also wanted the user to be able to move the component with the mouse, so I overrode the methods MouseDown, MouseUp, and MouseMove.

So far, what you have is a DBEdit that allows a user to change its position and size, but little else. The Font, Color, Tab Order, 3D effect, and Border will be done with the addition of the component ChangeMenu.

The basis for this component is found in the unit TypInfo.pas, which allows you to have access to an object's RTTI (runtime type information). TypInfo.pas contains functions and procedures that can Get or Set an object's property values during the execution of the application. Some simple methods of Setting or Getting an object's property value at runtime can look something like Listing 7.

Listing 7. Getting and Setting an object's property at runtime.

Function GetProperty(Sender:TComponent
                     ;sPropName:String):Variant
Var
   PropInfo : PPropinfo;
Begin
    // From the class information, get the property
    PropInfo := GetPropInfo(Sender.ClassInfo, 
                            sPropName);

    // Does the property exist?
    If (PropInfo <> Nil) Then Begin
       Case propinfo^.PropType^.Kind Of
          tkEnumeration,tkInteger:
             Begin
                Result :=  GetOrdProp(Sender,PropInfo)
             End;

          tkString,tkLString,tkWString:
             Begin
                Result := GetStrProp(Sender,PropInfo)
             End;
       End;
    End Else
       Result := Null;
End;


Procedure SetProperty(Sender:TComponent
                      ;sPropName:String
                      ;vValue:Variant)
Var
   PropInfo : PPropinfo;
Begin
    // From the class information, get the property
    PropInfo := GetPropInfo(Sender.ClassInfo, 
                            sPropName);

    // Does the property exist?
    If (PropInfo <> Nil) Then Begin
       Case propinfo^.PropType^.Kind Of

          tkEnumeration,tkInteger:
             Begin
                SetOrdProp(Sender,PropInfo,vValue);
             End;

          tkString,tkLString,tkWString:
             Begin
                SetStrProp(Sender,PropInfo,vValue);
             End;
       End;
    End;
End;

Usage of these two methods could look like this:

  SetProperty(DBEdit1,'Ctl3D',False);

  DBEdit2.Ctrl3D := GetProperty(DBEdit1.'Ctl3D') ;

Granted, this example is probably over-simplified, but procedures like these can be quite handy if you don't know the component's name, or even its class.

The three main methods used in ChangeMenu -- GetProperty(), SetProperty(), and IsProperty() -- are found in the unit PropFunc.pas that's part of this library. IsProperty() is a Boolean function that checks for the existence of a specified property in an object and returns a value of True if the property exists. It can be used something like this:

If IsProperty(Form1.Components[i],'Ctl3D') Then
   Components[i].Ctl3D := False ;

TChangeMenu is a subclass of TPopupMenu with two additional properties: FontDialog and ColorDialog, which are used to change the component's Font and Color and can point to any matching class types that are in the scope of the component. The methods MenuClick and OnMenuPopup do the bulk of the work and are assigned to the OnClick and OnPopup events of the menu items when the component is created. All this happens, of course, in the ChangeMenu unit (see Listing 8).

Listing 8. The ChangeMenu unit.

unit ChangeMenu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, 
  Controls, Forms, Dialogs, Menus,comctrls,
  StdCtrls,dbctrls, db,extctrls ;

type
  TChangeMenu = class(TPopupMenu)
  private
    { Private declarations }
    pm_Font       : TMenuItem ;
    pm_bgColor    : TMenuItem ;
    pm_TabOrder   : TMenuItem ;
    pm_Ctrl3D     : TMenuItem ;
    pm_BorderStyle: TMenuItem ;
    pm_Columns    : TMenuItem ;
    pm_Caption    : TMenuItem ;
    pm_Divider1   : TMenuItem ;
    pm_UpperCase  : TMenuItem ;
    pm_LowerCase  : TMenuItem ;
    pm_MixedCase  : TMenuItem ;
    pm_ProperCase : TMenuItem ;
    pm_Height     : TMenuItem ;
    pm_Width      : TMenuItem ;
    pm_Style      : TMenuItem ;
    fFontDialog   :TFontDialog ;
    fColorDialog  :TColorDialog ;

    Procedure SetColorDialog(Value:TColorDialog);
    Procedure SetFontDialog(Value:TFontDialog);
    Procedure MenuClick(Sender:TObject);
    Procedure OnMenuPopup(Sender:TObject) ;

  protected
    { Protected declarations }
  public
    { Public declarations }
    Procedure Loaded ; Override ;
    Destructor destroy; override ;
    Constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    Property FontDialog :TFontDialog
             Read fFontDialog
             Write SetFontDialog ;

    Property ColorDialog : TColorDialog
             Read fColorDialog
             Write SetColorDialog ;

  end;

procedure Register;

implementation

uses PropFunc, col_edit ;

Because of the specialized use of this menu, the menu items are created only at runtime, not at design-time in the IDE. After the menu items are created, the method MenuClick() is assigned to the OnClick event of each menu item. The menu will look like Figure 1.

The Loaded method (see Listing 9) captures the pointer to the component's OnPopup method, then assigns the OnPopup event to the method OnMenuPoup(). This is done so the developer's OnPopup method will execute after the OnMenuPopup method has finished processing its own menu items.

Listing 9. The Loaded method.

Procedure TChangeMenu.Loaded;
Begin
   Try
      // Save pointer to Component's OnPopup Method
      FOtherOnPopup := OnPopup ;
      // Assign OnPopup Method
      OnPopup := OnMenuPopup ;
   Finally
      Inherited ;
   End; 
End;

When the user right-clicks the mouse over the component, the OnMenuPopup method is executed (see Listing 10) and initializes the menu items based on the menu's PopupComponent property. PopupComponent is a pointer to the object that was responsible for activating the menu and is type TComponent. Notice the use of the method IsProperty to set the Visible property of the menu items.

Listing 10. The OnMenuPopup method.

Procedure TChangeMenu.OnMenuPopup(Sender:TObject) ;
// Initialize menu items based on the
// focused component's type and properties.
Var bSet : Boolean ;
Begin
   // Don't show Font item if the Font
   // Dialog property is Nil or the Font
   // Property doesn't exist in the focused
   // component.
   pm_Font.Visible :=
      (Not (FontDialog = Nil))
      And IsProperty(PopupComponent,'Font');

   // Don't show Color item if the ColorDialog
   // Property is Nil or the Color property doesn't
   // exist in the focused component.
   pm_bgColor.Visible :=
      Not (ColorDialog = Nil)
      And IsProperty(PopupComponent,'Color');

   // Initialize Radio and Checked Menu Items
   If IsProperty(PopupComponent,
                 'BorderStyle') Then Begin
      pm_BorderStyle.Checked :=
         (GetProperty(PopupComponent,
          'BorderStyle') = bsSingle) ;
      pm_BorderStyle.Visible := True ;
   End Else Begin
      pm_BorderStyle.Visible := False ;
   End;
   If IsProperty(PopupComponent,'Ctl3D') Then Begin
      pm_Ctrl3D.Checked :=
         GetProperty(PopupComponent,'Ctl3D');
      pm_Ctrl3D.Visible := True ;
   End Else Begin
      pm_Ctrl3D.Visible := False ;
   End;

   // If the TabOrder property exists in the component,
   // show the Menu item 'Tab Order'.
   pm_TabOrder.Visible:=
      IsProperty(PopupComponent,'TabOrder') ;

   // If the Columns property exists in the component
   // and the component is TListView,
   // show the menu item.
   If (PopupComponent Is TListView) Then
      pm_columns.Visible :=
         ( IsProperty(PopupComponent,'Columns') And
         (TListView(PopupComponent).Columns.Count >0))
   Else
      pm_columns.Visible := False ;

   // You should have the idea by now ...
   pm_Caption.Visible :=
      IsProperty(PopupComponent,'Caption');

   // If the focused component has CharCase and
   // AllowUser Change properties, then process more
   // menu items.
   If (IsProperty(PopupComponent,'CharCase')
         And IsProperty(PopupComponent,
                        'AllowUserChange')) Then Begin
      bSet := True ;

      // Don't show CharCase items if the
      // DataType isn't String.
      If IsProperty(PopupComponent,
                    'DataSource') Then Begin
         If (PopupComponent is TDBEdit) Then Begin
            With TDBEdit(PopupComponent) Do Begin
               If (DataField <> '') Then Begin
                  If Not (Field.DataType =
                          ftString) Then Begin
                     bSet := False ;
                  End;
               End Else
                  bSet := False ;
            End;
         End;
      End;

      pm_UpperCase.Visible  := bSet ;
      pm_LowerCase.Visible  := bSet ;
      pm_MixedCase.Visible  := bSet ;
      pm_ProperCase.Visible := bSet ;
      pm_Divider1.Visible   := bSet ;

      // Initialize CharCase Radio Items.
      Case GetProperty(PopupComponent,'CharCase') Of
        //ecNormal
        0: pm_MixedCase.Checked  := True ;
        //ecUpperCase
        1: pm_UpperCase.Checked  := True ;
        //ecLowerCase
        2: pm_LowerCase.Checked  := True ;
        //ecProperCase
        3: pm_ProperCase.Checked := True ;
      End;

   End Else Begin
      pm_UpperCase.Visible  := False ;
      pm_LowerCase.Visible  := False ;
      pm_MixedCase.Visible  := False ;
      pm_ProperCase.Visible := False ;
      pm_Divider1.Visible   := False ;
   End;

   pm_Width.Visible  := (PopupComponent is TBevel);
   pm_Height.Visible := (PopupComponent is TBevel);
   pm_Style.Visible  := (PopupComponent is TBevel);

   If pm_Style.Visible Then Begin
      If GetProperty(PopupComponent,'Style')=0 Then
         pm_Style.Caption := 'Raised Bevel'
      Else
         pm_Style.Caption := 'Lowered Bevel' ;
   End;
   // execute component's OnPopup Event.
   If Assigned(FOtherOnPopup) Then 
             FOtherOnPopup(Sender);
End;

When an item is selected (see Listing 11) the method SetProperty() is used to change the object's property values.

Listing 11. The MenuClick method.

Procedure TChangeMenu.MenuClick(Sender:TObject);
// Process the menu selection for the focused
// component.
Var
   sString : String ;
   i,iInt  : Integer ;
   b       : Boolean ;
Begin

   If (TMenuItem(Sender)= pm_Ctrl3D) Then Begin
      // Process 3D -  If 3D is selected
      // then BorderStyle must be changed
      // to Single.
      b := Not Boolean(GetProperty(PopupComponent,
                                             'Ctl3D'));

      SetProperty(PopupComponent,'Ctl3D',Ord(b));

      If b And (GetProperty(PopupComponent,
                          'BorderStyle') = bsNone) Then
         SetProperty(PopupComponent,
                     'BorderStyle',bsSingle);

   End Else If (TMenuItem(Sender)=
                             pm_BorderStyle) Then Begin
      // Process BorderStyle
      If (GetProperty(PopupComponent,
                 'BorderStyle') = bsSingle) Then Begin
         SetProperty(PopupComponent,
                     'BorderStyle',bsNone);
         // If BorderStyle is set to None, then
         // turn 3D Off.
         SetProperty(PopupComponent,'Ctl3D',False);
      End Else
         SetProperty(PopupComponent,
                     'BorderStyle',bsSingle);

   End Else If (TMenuItem(Sender)=
                                pm_TabOrder) Then Begin
      // Process TabOrder
      sString := IntToStr(GetProperty(PopupComponent,
                          'TabOrder'));
      Try
         sString := InputBox('Set Tab Order',
                            'Enter Tab Order',sString);
         iInt := StrToInt(sString);
         SetProperty(PopupComponent,'TabOrder',iInt) ;
      Except
         Raise Exception.Create('Tab Order Must '+
                                'Be An Integer');
      End;
   End Else If (TMenuItem(Sender)= pm_Font) Then Begin
      // Process Font selection
      If (FontDialog <> Nil) Then Begin
         FontDialog.Font.Name  :=
            GetProperty(PopupComponent,'Font.Name') ;
         FontDialog.Font.Size  :=
            GetProperty(PopupComponent,'Font.Size') ;
         FontDialog.Font.Color :=
            GetProperty(PopupComponent,'Font.Color') ;
         FontDialog.Font.Style :=
            TFontStyles(TFontStyle(
            GetProperty(PopupComponent,'Font.Style')));

         If FontDialog.Execute Then Begin
            SetProperty(PopupComponent,'Font.Name'
                        ,FontDialog.Font.Name);
            SetProperty(PopupComponent,'Font.Size',
                        FontDialog.Font.Size);
            SetProperty(PopupComponent,'Font.Color',
                        FontDialog.Font.Color);
            SetProperty(PopupComponent,'Font.Style',
               Ord(TFontStyle(FontDialog.Font.Style)));

            // Force Font Height to refresh
            // the component
            i:= GetProperty(PopupComponent,
                            'Font.Height');
            SetProperty(PopupComponent,
                        'Font.Height',i+(-5));
            SetProperty(PopupComponent,
                        'Font.Height',i);
         End;
      End;
   End Else If (TMenuItem(Sender) =
                                 pm_BgColor) Then Begin
      // Process Color
      If ColorDialog <> Nil Then Begin
         ColorDialog.Color :=
            GetProperty(PopupComponent,'Color') ;
         If ColorDialog.Execute Then Begin
            SetProperty(PopupComponent,'Color',
                        ColorDialog.Color) ;
         End;
      End;
   End Else If (TMenuItem(Sender) =
                                 pm_Caption) Then Begin
      // Process Caption
      sString := GetProperty(PopupComponent,'Caption');
      sString := InputBox('Change Caption',
                          'Enter Caption',sString);
      SetProperty(PopupComponent,'Caption',sString) ;
   End Else If (TMenuItem(Sender) =
                                 pm_columns) Then Begin
      // Process Columns for TListView.  This is done
      // with an external form.
      Application.CreateForm(TfrmEditColumns,
                             frmEditColumns);
      Try
         frmEditColumns.ColObject :=
            TListView(PopupComponent) ;
         frmEditColumns.ShowModal ;
      Finally
         frmEditColumns.Free ;
      End;
   End Else If (TMenuItem(Sender)=pm_Width) Then Begin
      // Process Width for TBevel
      sString := IntToStr(GetProperty(PopupComponent,
                                      'Width'));
      Try
         sString := InputBox('Set Width',
                             'Enter Width',sString);
         iInt := StrToInt(sString);
         SetProperty(PopupComponent,'Width',iInt) ;
      Except
         Raise Exception.Create('Width Must Be '+
                                'An Integer');
      End;

   End Else If (TMenuItem(Sender)=pm_Height) Then Begin
      // Process Height for TBevel
      sString := IntToStr(GetProperty(PopupComponent,
                                      'Height'));
      Try
         sString := InputBox('Set Height',
                             'Enter Height',sString);
         iInt := StrToInt(sString);
         SetProperty(PopupComponent,'Height',iInt) ;
      Except
         Raise Exception.Create('Height Must Be '+
                                'An Integer');
      End;

   End Else If (TMenuItem(Sender)=pm_Style) Then Begin
      // Process Bevel Stype for TBevel
      // Raised or Lowered
      If GetProperty(PopupComponent,'Style')=0 Then
         SetProperty(PopupComponent,'Style',1)
      Else
         SetProperty(PopupComponent,'Style',0)

   End Else Begin
      TMenuItem(Sender).Checked :=
         Not TMenuItem(Sender).Checked;
      If pm_MixedCase.Checked Then Begin
         // Normal
         SetProperty(PopupComponent,'CharCase',0) ;
      End Else If pm_UpperCase.Checked Then Begin
         //CharCase := ecUpperCase ;
         SetProperty(PopupComponent,'CharCase',1) ;
      End Else If pm_LowerCase.Checked Then Begin
         //CharCase := ecLowerCase ;
         SetProperty(PopupComponent,'CharCase',2) ;
      End Else If pm_ProperCase.Checked Then Begin
         //CharCase := ecProperCase ;
         SetProperty(PopupComponent,'CharCase',3) ;
      End;
   End;
End;

TChangeMenu can actually be used on almost any standard component that has any of the supported properties. It even supports TListView column headings and widths.

Half-way there
Creating a component that allows the user to change its size, position, font, color, and so forth is good. But it isn't very helpful without the ability so save and restore the changed properties. You don't want your users to have to customize the application again and again every time they run your application, do you? The next step is to create a component that has the ability to save and restore the classes and properties that the developer specifies.

TComponentStates
When designing the component to save the component property values, I wanted to make it flexible enough to save only the values that the developer wanted. The values needed to be stored in a place that would be easily accessible and transportable. I also wanted the values to be able to be accessed by more than one user or workstation. For these reasons, I chose to store the property values in an INI file instead of the Windows Registry.

TComponentStates works in much the same way TChangeMenu does by accessing the routines in PropFunc.pas to Save and Restore component properties at runtime. There are three exposed methods in this component: Save, Restore, and SetProperties. I think the first two are self-explanatory. The SetProperties method is used to set a specific property of all objects on the form that are of the same class type. For example, if I wanted to change the font of all the TDBEdit objects on Form1 to Arial 12, the code would look like this:

ComponentStates1.SetProperties(Form1,'TDBEdit',
                               'Font.Name','Arial');
ComponentStates1.SetProperties(Form1,'TDBEdit',
                               'Font.Size',12);

The routine to accomplish this is actually not too complicated. It uses the SetProperty method in PropFunc.pas, as discussed earlier. It spins through all the components on the form and checks the classname. If the classname is a match, it executes the SetProperty() method, changing the component's property (see Listing 12).

Listing 12. The SetProperties method.

Procedure TComponentStates.SetProperties(
                           Const Frm:TForm
                           ;Const sClassName:String
                           ;Const sPropertyName:String
                           ;Const vValue:Variant);

//****************************************************
//Sets all components properties on the Form Frm where
//component.classname = sClassName with vValue.
//****************************************************

Var i : Integer ;
Begin
   With Frm Do Begin
      For i := 0 To (ComponentCount-1) Do Begin
         If Components[i].ClassNameIs(sClassName) Then 
         Begin
            SetProperty(Components[i],sPropertyName,
                        vValue);
         End;
      End;
   End; //with Frm
End;

The most essential property in this component is ClassesToSave. It's a TStrings type that contains a list of classes and properties to save to the INI file. For example, to save all the essential information about each TPSIDBEdit that's on the form, the contents of ClassesToSave would look like this:

TPSIDBEdit.Left
TPSIDBEdit.Top
TPSIDBEdit.Height
TPSIDBEdit.Width
TPSIDBEdit.TabOrder
TPSIDBEdit.Font.Name
TPSIDBEdit.Font.Size
TPSIDBEdit.Font.Style
TPSIDBEdit.Font.Color
TPSIDBEdit.Color
TPSIDBEdit.Ctl3D
TPSIDBEdit.BorderStyle
TPSIDBEdit.CharCase

When the Save method is executed, the INI file would look something like this:

[Form1]
PSIDBEdit1.Left=313
PSIDBEdit1.Top=319
PSIDBEdit1.Height=21
PSIDBEdit1.Width=121
PSIDBEdit1.TabOrder=5
PSIDBEdit1.Font.Name=MS Sans Serif
PSIDBEdit1.Font.Size=8
PSIDBEdit1.Font.Style=0
PSIDBEdit1.Font.Color=-2147483640
PSIDBEdit1.Color=-2147483643
PSIDBEdit1.Ctl3D=1
PSIDBEdit1.BorderStyle=1
PSIDBEdit1.CharCase=0

The Save and Restore methods use the same procedure called Process (see Listing 13). The Boolean parameter bSave is the switch for saving or restoring the values.

Listing 13. The Process method.

Procedure TComponentStates.Process(bSave:Boolean);
Var
   i,ii          : Integer ;
   sPropertyName : String ;
   sSection      : String ;
   sClassName    : String ;
   sID           : String ;
   vValue        : Variant ;
   slPropList    : TStrings ;
Begin
  If Not Active Then Exit ;
  slPropList := TStringList.Create ;
  fIniFile   := TIniFile.Create(FIniPath+
                                SaveToINIFileName);
  Try

    // Use the form's name for the section ID in 
    // the INI file.
    sSection := fOwner.Name ;

    For i := 0 To (fOwner.ComponentCount-1) Do Begin
      slPropList.Clear ;
      sClassName := fOwner.Components[i].ClassName ;

      // Get Property List For Class

      slPropList.Text := 
         ProcessClass(fOwner.Components[i]) ;
      If (slPropList.Text <> '') Then Begin

        //*********************************************
        //Process all defined properties for this Class
        //*********************************************

        For ii := 0 To (slPropList.Count-1) Do Begin
          sPropertyName := slPropList.Strings[ii] ;
          sID := fOwner.Components[i].Name+'.'+
                 sPropertyName ;

         If bSave Then Begin
           // Write Property Values to INI file

           vValue := GetProperty(fOwner.Components[i],
                                        sPropertyName);

           If (vValue <> Null) Then Begin
              Case VarType(vValue) Of
                 varInteger:
                    fIniFile.WriteInteger(sSection,sID,
                                          vValue);
                 varString:
                    fIniFile.WriteString(sSection,
                                         sID,vValue);
              End; // Case VarType(vValue)
           End;

         End Else Begin
           // ***********************************
           // Read property from INI file and set
           // component's property.
           // ***********************************

           // Get Current Property Value as a default

           vValue := GetProperty(fOwner.Components[i],
                                        sPropertyName);

           If (vValue <> Null) Then Begin
             // Read property value from INI file
             Case VarType(vValue) Of
               varInteger:
                 Begin
                   vValue := 
                        fIniFile.ReadInteger(sSection,
                                             sID,
                                             vValue);
                 End;

                varString:
                 Begin
                   vValue := 
                      fIniFile.ReadString(sSection,
                                          sID,
                                          vValue);
                 End;
                Else
                   vValue := Null ;
             End; // Case VarType(vValue)

             If (vValue <> Null) Then Begin
               SetProperty(fOwner.Components[i],
                           sPropertyName,vValue);
             End;

            End;
          End; // If bSave
        End; // For ii
       End; // If (slPropList.Text <> '')
    End; // For i
  Finally
    slPropList.Free ;
    fIniFile.Free ;
  End;
End;

A single INI file can be used to save the component values for every form in the application. It uses the Form's name property for the INI file's section ID and places each component's values for the form under the ID.

Putting it all together
The final step is actually using these components together. I thought building a simple address book would be easiest.

Starting with the DataModule, I added a ColorDialog, FontDialog, ComponentStates, ChangeMenu, Table, and DataSource (see Figure 2). Then I filled in the FontDialog and ColorDialog properties of the ChangeMenu to point to the Color and Font dialogs that are on the DataModule. I then pointed the Table to ADDRESS.DBF, and the DataSource to the Table. I also changed the ComponentStates.Active property to True.

The next step is to lay out the form using the TPSIDBEdit and point them to their respective fields, and populate the ChangeMenu property to point to the TChangeMenu that's on the DataModule. I also added a couple of buttons that globally change the background and font of all the TPSIDBEdit's on the form, and a CheckBox that changes the component's AllowUserChange property to True or False. I used another subclassed label component, TLabel3D, that has some of the same changeable features found in TPSIDBEdit, in order to show the flexibility of these components. Label3D.pas is included in the accompanying Download file (available from www.hardcoredelphi.com) . Figure 3 shows the complete Address Book form.

Next I populated the ClassesToSave property (see Figure 4) of the ComponentStates component with all the classes and properties I wanted saved as part of this application.

In the OnShow event of the form, I placed the code that will restore the saved values from the INI file. The Restore() and Save() methods take one parameter and is the TForm that is to be processed. In this I case, I used the Self pointer to make it generic.

procedure TForm1.FormShow(Sender: TObject);
begin
   DataModule1.ComponentStates1.Restore(Self);
end;

The Save() method can be implemented a couple of different ways. You can place the Save code in the OnClose event of the Form, or you can give the user a button or menu item to use to save the GUI changes. In this example, I used the OnClose event of the form. But in a live application, I'd probably use a Button or Menu item for the save.

procedure TForm1.FormClose(Sender: Tobject
                       ;var Action: TCloseAction);
begin
   DataModule1.ComponentStates1.Save(Self);
end;

To change the AllowUserChange property for all the components, I used the SetProperties method in the OnClick event of the CheckBox. I pass in the TForm using Self, the classname and the property I want changed, and the value to change it to.

procedure TForm1.cbAllowUserChangeClick(Sender: 
                                        TObject);
begin
   // Globally set the property of AllowUserChange on
   // all Components that are of type TPSIDBEdit
   // and TLabel3D
   With DataModule1.ComponentStates1 Do Begin
    SetProperties(Self,'TPSIDBEdit','AllowUserChange',
                  cbAllowUserChange.Checked);
    SetProperties(Self,'TLabel3D','AllowUserChange',
                  cbAllowUserChange.Checked);
   End;
end;

To globally change the Font and Color of all the TPSIDBEdit objects on the form, I again used the SetProperties() method of the TComponentStates object:

procedure TForm1.btnGlobalBGClick(Sender: TObject);
begin
   // Globally set the Color property of
   // all Components that are of type TPSIDBEdit.
   With DataModule1 Do Begin
      If ColorDialog1.Execute Then Begin
         ComponentStates1.SetProperties(
                 Self,'TPSIDBEdit','Color',
                 ColorDialog1.Color);
      End;
   End;
end;

procedure TForm1.btnGlobalFGClick(Sender: TObject);
begin
   // Globally set the Font.Color property of
   // all Components that are of type TPSIDBEdit.
   With DataModule1 Do Begin
      If ColorDialog1.Execute Then Begin
         ComponentStates1.SetProperties(
                 Self,'TPSIDBEdit','Font.Color',
                 ColorDialog1.Color);
      End;
   End;
end;

While not every application you build will require the user to change the GUI, think how nice it would be if you didn't have to hard-code the changes, recompile, and hand your client a new application only to hear, "Oh, there's just one more thing . . ."