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:
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 You have these options, in order of difficulty:
- Create a frame, and reuse it
- Create a compound control (using maybe a panel, labels and checkboxes). Each control will handle its own keyboard/mouse interaction.
- Create a whole new control - all elements are drawn using the proper APIs and all keyboard/mouse interaction is handled by the control code.
来源：https://stackoverflow.com/questions/3900833/custom-control-creation-in-delphi