Ndtyjky

i used to this on a form and create it like 10 times, that was ok, until i tried to pass this number, it started eating system resources, is there anyway i could create a component like this? it for a Simulator project, 8bits needed to indicate the value of the register in binary

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

I agree that there shouldn't be a problem with a hundred checkboxes on a form. But for fun's sake, I just wrote a component that does all drawing manually, so there is only one window handle per control (that is, per eight checkboxes). My control works both with visual themes enabled and with themes disabled. It is also double-buffered, and completely flicker-free.

unit ByteEditor;



interface



uses

  Windows, SysUtils, Classes, Messages, Controls, Graphics, Themes, UxTheme;



type

  TWinControlCracker = class(TWinControl); // because necessary method SelectNext is protected...



  TByteEditor = class(TCustomControl)

  private

    { Private declarations }

    FTextLabel: TCaption;

    FBuffer: TBitmap;

    FValue: byte;

    CheckboxRect: array[0..7] of TRect;

    LabelRect: array[0..7] of TRect;

    FSpacing: integer;

    FVerticalSpacing: integer;

    FLabelSpacing: integer;

    FLabelWidth, FLabelHeight: integer;

    FShowHex: boolean;

    FHexPrefix: string;

    FMouseHoverIndex: integer;

    FKeyboardFocusIndex: integer;

    FOnChange: TNotifyEvent;

    FManualLabelWidth: integer;

    FAutoLabelSize: boolean;

    FLabelAlignment: TAlignment;

    procedure SetTextLabel(const TextLabel: TCaption);

    procedure SetValue(const Value: byte);

    procedure SetSpacing(const Spacing: integer);

    procedure SetVerticalSpacing(const VerticalSpacing: integer);

    procedure SetLabelSpacing(const LabelSpacing: integer);

    procedure SetShowHex(const ShowHex: boolean);

    procedure SetHexPrefix(const HexPrefix: string);

    procedure SetManualLabelWidth(const ManualLabelWidth: integer);

    procedure SetAutoLabelSize(const AutoLabelSize: boolean);

    procedure SetLabelAlignment(const LabelAlignment: TAlignment);

    procedure UpdateMetrics;

  protected

    { Protected declarations }

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    procedure Paint; override;

    procedure WndProc(var Msg: TMessage); override;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;

    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;

    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    procedure KeyUp(var Key: Word; Shift: TShiftState); override;

  public

    { Public declarations }

  published

    { Published declarations }

    property Color;

    property LabelAlignment: TAlignment read FLabelAlignment write SetLabelAlignment default taRightJustify;

    property AutoLabelSize: boolean read FAutoLabelSize write SetAutoLabelSize default true;

    property ManualLabelWidth: integer read FManualLabelWidth write SetManualLabelWidth default 64;

    property TextLabel: TCaption read FTextLabel write SetTextLabel;

    property Value: byte read FValue write SetValue default 0;

    property Spacing: integer read FSpacing write SetSpacing default 3;

    property VerticalSpacing: integer read FVerticalSpacing write SetVerticalSpacing default 3;

    property LabelSpacing: integer read FLabelSpacing write SetLabelSpacing default 8;

    property ShowHex: boolean read FShowHex write SetShowHex default false;

    property HexPrefix: string read FHexPrefix write SetHexPrefix;

    property TabOrder;

    property TabStop;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;

  end;



procedure Register;



implementation



const

  PowersOfTwo: array[0..7] of byte = (1, 2, 4, 8, 16, 32, 64, 128); // PowersOfTwo[n] := 2^n

  BasicCheckbox: TThemedElementDetails = (Element: teButton; Part: BP_CHECKBOX; State: CBS_UNCHECKEDNORMAL);



procedure Register;

begin

  RegisterComponents('Rejbrand 2009', [TByteEditor]);

end;



function IsIntInInterval(x, xmin, xmax: integer): boolean; inline;

begin

  IsIntInInterval := (xmin <= x) and (x <= xmax);

end;



function PointInRect(const Point: TPoint; const Rect: TRect): boolean; inline;

begin

  PointInRect := IsIntInInterval(Point.X, Rect.Left, Rect.Right) and

                 IsIntInInterval(Point.Y, Rect.Top, Rect.Bottom);

end;



function GrowRect(const Rect: TRect): TRect;

begin

  result.Left := Rect.Left - 1;

  result.Top := Rect.Top - 1;

  result.Right := Rect.Right + 1;

  result.Bottom := Rect.Bottom + 1;

end;



{ TByteEditor }



constructor TByteEditor.Create(AOwner: TComponent);

begin

  inherited;

  FLabelAlignment := taRightJustify;

  FManualLabelWidth := 64;

  FAutoLabelSize := true;

  FTextLabel := 'Register:';

  FValue := 0;

  FSpacing := 3;

  FVerticalSpacing := 3;

  FLabelSpacing := 8;

  FMouseHoverIndex := -1;

  FKeyboardFocusIndex := 7;

  FHexPrefix := '$';

  FShowHex := false;

  FBuffer := TBitmap.Create;

end;



destructor TByteEditor.Destroy;

begin

  FBuffer.Free;

  inherited;

end;



procedure TByteEditor.KeyDown(var Key: Word; Shift: TShiftState);

begin

  inherited;

  case Key of

    VK_TAB:

      if TabStop then

        begin

          if ssShift in Shift then

            if FKeyboardFocusIndex = 7 then

              TWinControlCracker(Parent).SelectNext(Self, false, true)

            else

              inc(FKeyboardFocusIndex)

          else

            if FKeyboardFocusIndex = 0 then

              TWinControlCracker(Parent).SelectNext(Self, true, true)

            else

              dec(FKeyboardFocusIndex);

          Paint;

        end;

    VK_SPACE:

      SetValue(FValue xor PowersOfTwo[FKeyboardFocusIndex]);

  end;

end;



procedure TByteEditor.KeyUp(var Key: Word; Shift: TShiftState);

begin

  inherited;



end;



procedure TByteEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X,

  Y: Integer);

begin

  inherited;

  if TabStop then SetFocus;

  FKeyboardFocusIndex := FMouseHoverIndex;

  Paint;

end;



procedure TByteEditor.MouseMove(Shift: TShiftState; X, Y: Integer);

var

  i: Integer;

  OldIndex: integer;

begin

  inherited;

  OldIndex := FMouseHoverIndex;

  FMouseHoverIndex := -1;

  for i := 0 to 7 do

    if PointInRect(point(X, Y), CheckboxRect[i]) then

    begin

      FMouseHoverIndex := i;

      break;

    end;

  if FMouseHoverIndex <> OldIndex then

    Paint;

end;



procedure TByteEditor.MouseUp(Button: TMouseButton; Shift: TShiftState; X,

  Y: Integer);

begin

  inherited;

  Paint;

  if (FMouseHoverIndex <> -1) and (Button = mbLeft) then

  begin

    SetValue(FValue xor PowersOfTwo[FMouseHoverIndex]);

    if Assigned(FOnChange) then

      FOnChange(Self);

  end;

end;



const

  DTAlign: array[TAlignment] of cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER);



procedure TByteEditor.Paint;

var

  details: TThemedElementDetails;

  i: Integer;

  TextRect: TRect;

  HexStr: string;

begin

  inherited;

  FBuffer.Canvas.Brush.Color := Color;

  FBuffer.Canvas.FillRect(ClientRect);



  TextRect := Rect(0, 0, FLabelWidth, Height);

  DrawText(FBuffer.Canvas.Handle, FTextLabel, length(FTextLabel), TextRect,

    DT_SINGLELINE or DT_VCENTER or DTAlign[FLabelAlignment] or DT_NOCLIP);



  for i := 0 to 7 do

  begin

    if ThemeServices.ThemesEnabled then

      with details do

      begin

        Element := teButton;

        Part := BP_CHECKBOX;

        if FMouseHoverIndex = i then

          if csLButtonDown in ControlState then

            if FValue and PowersOfTwo[i] <> 0 then

              State := CBS_CHECKEDPRESSED

            else

              State := CBS_UNCHECKEDPRESSED

          else

            if FValue and PowersOfTwo[i] <> 0 then

              State := CBS_CHECKEDHOT

            else

              State := CBS_UNCHECKEDHOT

        else

          if FValue and PowersOfTwo[i] <> 0 then

            State := CBS_CHECKEDNORMAL

          else

            State := CBS_UNCHECKEDNORMAL;

        ThemeServices.DrawElement(FBuffer.Canvas.Handle, details, CheckboxRect[i]);

      end

    else

    begin

      if FMouseHoverIndex = i then

        if csLButtonDown in ControlState then

          if FValue and PowersOfTwo[i] <> 0 then

            DrawFrameControl(FBuffer.Canvas.Handle, CheckboxRect[i], DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED or DFCS_PUSHED)

          else

            DrawFrameControl(FBuffer.Canvas.Handle, CheckboxRect[i], DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_PUSHED)

        else

          if FValue and PowersOfTwo[i] <> 0 then

            DrawFrameControl(FBuffer.Canvas.Handle, CheckboxRect[i], DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED or DFCS_HOT)

          else

            DrawFrameControl(FBuffer.Canvas.Handle, CheckboxRect[i], DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_HOT)

      else

        if FValue and PowersOfTwo[i] <> 0 then

          DrawFrameControl(FBuffer.Canvas.Handle, CheckboxRect[i], DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED)

        else

          DrawFrameControl(FBuffer.Canvas.Handle, CheckboxRect[i], DFC_BUTTON, DFCS_BUTTONCHECK)

    end;

    TextRect := LabelRect[i];

    DrawText(FBuffer.Canvas.Handle, IntToStr(i), 1, TextRect, DT_SINGLELINE or DT_TOP or DT_CENTER or DT_NOCLIP);

  end;



  if Focused then

    DrawFocusRect(FBuffer.Canvas.Handle, GrowRect(CheckboxRect[FKeyboardFocusIndex]));



  if FShowHex then

  begin

    TextRect.Left := CheckboxRect[7].Left;

    TextRect.Right := CheckboxRect[0].Right;

    TextRect.Top := CheckboxRect[7].Bottom + FVerticalSpacing;

    TextRect.Bottom := TextRect.Top + FLabelHeight;

    HexStr := 'Value = ' + IntToStr(FValue) + ' (' + FHexPrefix + IntToHex(FValue, 2) + ')';

    DrawText(FBuffer.Canvas.Handle, HexStr, length(HexStr), TextRect,

      DT_SINGLELINE or DT_CENTER or DT_NOCLIP);

  end;



  BitBlt(Canvas.Handle, 0, 0, Width, Height, FBuffer.Canvas.Handle, 0, 0, SRCCOPY);





end;



procedure TByteEditor.SetShowHex(const ShowHex: boolean);

begin

  if ShowHex <> FShowHex then

  begin

    FShowHex := ShowHex;

    Paint;

  end;

end;



procedure TByteEditor.SetSpacing(const Spacing: integer);

begin

  if Spacing <> FSpacing then

  begin

    FSpacing := Spacing;

    UpdateMetrics;

    Paint;

  end;

end;



procedure TByteEditor.SetVerticalSpacing(const VerticalSpacing: integer);

begin

  if VerticalSpacing <> FVerticalSpacing then

  begin

    FVerticalSpacing := VerticalSpacing;

    UpdateMetrics;

    Paint;

  end;

end;



procedure TByteEditor.SetAutoLabelSize(const AutoLabelSize: boolean);

begin

  if FAutoLabelSize <> AutoLabelSize then

  begin

    FAutoLabelSize := AutoLabelSize;

    UpdateMetrics;

    Paint;

  end;

end;



procedure TByteEditor.SetHexPrefix(const HexPrefix: string);

begin

  if not SameStr(FHexPrefix, HexPrefix) then

  begin

    FHexPrefix := HexPrefix;

    Paint;

  end;

end;



procedure TByteEditor.SetLabelAlignment(const LabelAlignment: TAlignment);

begin

  if FLabelAlignment <> LabelAlignment then

  begin

    FLabelAlignment := LabelAlignment;

    Paint;

  end;

end;



procedure TByteEditor.SetLabelSpacing(const LabelSpacing: integer);

begin

  if LabelSpacing <> FLabelSpacing then

  begin

    FLabelSpacing := LabelSpacing;

    UpdateMetrics;

    Paint;

  end;

end;



procedure TByteEditor.SetManualLabelWidth(const ManualLabelWidth: integer);

begin

  if FManualLabelWidth <> ManualLabelWidth then

  begin

    FManualLabelWidth := ManualLabelWidth;

    UpdateMetrics;

    Paint;

  end;

end;



procedure TByteEditor.SetTextLabel(const TextLabel: TCaption);

begin

  if not SameStr(TextLabel, FTextLabel) then

  begin

    FTextLabel := TextLabel;

    UpdateMetrics;

    Paint;

  end;

end;



procedure TByteEditor.SetValue(const Value: byte);

begin

  if Value <> FValue then

  begin

    FValue := Value;

    Paint;

  end;

end;



procedure TByteEditor.WndProc(var Msg: TMessage);

begin

  inherited;

  case Msg.Msg of

    WM_GETDLGCODE:

      Msg.Result := Msg.Result or DLGC_WANTTAB or DLGC_WANTARROWS or DLGC_WANTALLKEYS;

    WM_ERASEBKGND:

      Msg.Result := 1;

    WM_SIZE:

      begin

        UpdateMetrics;

        Paint;

      end;

    WM_SETFOCUS, WM_KILLFOCUS:

      Paint;

  end;

end;



procedure TByteEditor.UpdateMetrics;

var

  CheckboxWidth, CheckboxHeight: integer;

  i: Integer;

begin

  FBuffer.SetSize(Width, Height);

  FBuffer.Canvas.Font.Assign(Font);

  with FBuffer.Canvas.TextExtent(FTextLabel) do

  begin

    if FAutoLabeLSize then

      FLabelWidth := cx

    else

      FLabelWidth := FManualLabelWidth;

    FLabelHeight := cy;

  end;

  CheckboxWidth := GetSystemMetrics(SM_CXMENUCHECK);

  CheckboxHeight := GetSystemMetrics(SM_CYMENUCHECK);

  for i := 0 to 7 do

  begin

    with CheckboxRect[i] do

    begin

      Left := (FLabelWidth + FLabelSpacing) + (7-i) * (CheckboxWidth + FSpacing);

      Right := Left + CheckboxWidth;

      Top := (Height - (CheckboxHeight)) div 2;

      Bottom := Top + CheckboxHeight;

    end;

    LabelRect[i].Left := CheckboxRect[i].Left;

    LabelRect[i].Right := CheckboxRect[i].Right;

    LabelRect[i].Top := CheckboxRect[i].Top - FLabelHeight - FVerticalSpacing;

    LabelRect[i].Bottom := CheckboxRect[i].Top;

  end;

  Width := (FLabelWidth + FLabelSpacing) + 8 * (CheckboxWidth + FSpacing);

end;





end.

Example:

(High-Res)

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.

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]      |     [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