我曾经在一个表单上使用它并创建它10次,这没关系,直到我试图传递这个数字,它开始吃系统资源,无论如何我可以创建这样的组件?对于模拟器项目,需要8位来指示二进制寄存器的值
任何帮助,评论,想法都非常感激。 TY。
答案 0 :(得分:20)
我有点无聊,我想玩我的新Delphi XE,所以我为你做了一个组件。它应该适用于较旧的Delphi。
您可以在此处下载:BitEditSample.zip
zipfile包含一个组件,一个包和一个示例应用程序(包括一个已编译的exe,因此您可以快速尝试)。
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.
我猜OP面临的问题是反馈循环,其中两个事件处理程序互相调用。
使用更多位编辑器时,其他资源似乎不会以不寻常的方式增加。我已经使用具有位编辑组件的许多实例的应用程序对其进行了测试:
[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
答案 1 :(得分:16)
我同意表单上的一百个复选框应该没有问题。但是为了好玩,我只是编写了一个手动绘制所有绘图的组件,因此每个控件只有一个窗口句柄(即每8个复选框)。我的控件适用于启用视觉主题和禁用主题。它也是双缓冲的,完全没有闪烁。
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.
示例:
答案 2 :(得分:2)
根据难度,您有以下选项: