Custom Control Creation in Delphi

killercode picture killercode · Oct 10, 2010 · Viewed 9k times · Source

I used this on a form and created it like 10 times. That was ok, until I tried to pass this number. Then it started eating system resources. Is there any way I could create a component like this? It is for a Simulator project, 8bits needed to indicate the value of the register in binary.

alt text

any help, comments, ideas are really appreciated. ty.

Answer

Wouter van Nifterick picture Wouter van Nifterick · Oct 10, 2010

I was slightly bored, and I wanted to play with my new Delphi XE, so I've made a component for you. It should work in older Delphi's just fine.

BitEdit demo app

You can download it here: BitEditSample.zip

How does it work?

  • It inherits from customcontrol, so you can focus the component.
  • It contains an array of labels and checkboxes.
  • The bit number is stored in the "tag" property of each checkbox
  • Each checkbox gets an onchange handler that reads the tag, to see which bit needs to be manipulated.

How to use it

  • It has a property "value". If you change it, the checkboxes will update.
  • If you click the checkboxes, the value will change.
  • Set the property "caption" to change the text that says "Register X:"
  • You can create an "onchange" event handler, so that when the value changes (because of a mouseclick for example), you'll be notified.

The zipfile contains a component, a package, and a sample application (including a compiled exe, so you can try it out quickly).

unit BitEdit;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, ExtCtrls;

type
  TBitEdit = class(TCustomControl)
  private
    FValue         : Byte; // store the byte value internally
    FBitLabels     : Array[0..7] of TLabel; // the 7 6 5 4 3 2 1 0 labels
    FBitCheckboxes : Array[0..7] of TCheckBox;
    FCaptionLabel  : TLabel;
    FOnChange      : TNotifyEvent;
    function GetValue: byte;
    procedure SetValue(const aValue: byte);
    procedure SetCaption(const aValue: TCaption);
    procedure SetOnChange(const aValue: TNotifyEvent);
    function GetCaption: TCaption;
    { Private declarations }
  protected
    { Protected declarations }
    procedure DoBitCheckboxClick(Sender:TObject);
    procedure UpdateGUI;
    procedure DoOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    { Public declarations }
  published
    property Value:byte read GetValue write SetValue;
    property Caption:TCaption read GetCaption write SetCaption;
    property OnChange:TNotifyEvent read FOnChange write SetOnChange;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TBitEdit]);
end;

{ TBitEdit }

constructor TBitEdit.Create(AOwner: TComponent);
var
  I:Integer;
begin
  inherited;
  Width := 193;
  Height := 33;

  FCaptionLabel := TLabel.Create(self);
  FCaptionLabel.Left := 0;
  FCaptionLabel.Top  := 10;
  FCaptionLabel.Caption := 'Register X :';
  FCaptionLabel.Width := 60;
  FCaptionLabel.Parent := self;
  FCaptionLabel.Show;


  for I := 0 to 7 do
  begin
    FBitCheckboxes[I] := TCheckBox.Create(self);
    FBitCheckboxes[I].Parent := self;
    FBitCheckboxes[I].Left   := 5 + FCaptionLabel.Width + (16 * I);
    FBitCheckboxes[I].Top    := 14;
    FBitCheckboxes[I].Caption := '';
    FBitCheckboxes[I].Tag  := 7-I;
    FBitCheckboxes[I].Hint := 'bit ' + IntToStr(FBitCheckboxes[I].Tag);
    FBitCheckboxes[I].OnClick := DoBitCheckboxClick;
  end;

  for I := 0 to 7 do
  begin
    FBitLabels[I] := TLabel.Create(Self);
    FBitLabels[I].Parent := self;
    FBitLabels[I].Left   := 8 + FCaptionLabel.Width + (16 * I);
    FBitLabels[I].Top    := 0;
    FBitLabels[I].Caption := '';
    FBitLabels[I].Tag  := 7-I;
    FBitLabels[I].Hint := 'bit ' + IntToStr(FBitLabels[I].Tag);
    FBitLabels[I].Caption := IntToStr(FBitLabels[I].Tag);
    FBitLabels[I].OnClick := DoBitCheckboxClick;
  end;


end;

procedure TBitEdit.DoBitCheckboxClick(Sender: TObject);
var
  LCheckbox:TCheckbox;
  FOldValue:Byte;
begin
  if not (Sender is TCheckBox) then
    Exit;

  FOldValue := FValue;
  LCheckbox := Sender as TCheckbox;
  FValue := FValue XOR (1 shl LCheckbox.Tag);

  if FOldValue <> FValue then
    DoOnChange;
end;

procedure TBitEdit.DoOnChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TBitEdit.GetCaption: TCaption;
begin
  Result := FCaptionLabel.Caption;
end;

function TBitEdit.GetValue: byte;
begin
  Result := FValue;
end;

procedure TBitEdit.SetCaption(const aValue: TCaption);
begin
  FCaptionLabel.Caption := aValue;
end;

procedure TBitEdit.SetOnChange(const aValue: TNotifyEvent);
begin
  FOnChange := aValue;
end;

procedure TBitEdit.SetValue(const aValue: byte);
begin
  if aValue=FValue then
    Exit;

  FValue := aValue;
  DoOnChange;
  UpdateGUI;
end;

procedure TBitEdit.UpdateGUI;
var
  I:Integer;
begin
  for I := 0 to 7 do
    FBitCheckboxes[I].Checked := FValue shr FBitCheckboxes[I].Tag mod 2 = 1;
end;

end.

Resources

I guess the problem that the OP was facing is a feedback loop, where two event handlers call each other.

Other resources don't seem to increase in an unusual way when using more bit editors. I've tested it with an application with many instances of the bit edit component:

Many

             [MANY]      |     [1]
-------------------------+--------------
#Handles                 |   
User       :   314       |          35
GDI        :    57       |          57
System     :   385       |         385
#Memory                  |
Physical   : 8264K       |       7740K
Virtual    : 3500K       |       3482K
#CPU                     | 
Kernel time: 0:00:00.468 |  0:00:00.125
User time  : 0:00:00.109 |  0:00:00.062