Pfthb

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