本文介绍了Delphi 中的自定义控件创建的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我在表单上使用了它并创建了 10 次.没关系，直到我试图传递这个数字.然后它开始吃系统资源.有什么办法可以创建这样的组件吗?用于Simulator工程，需要8bits以二进制表示寄存器的值.
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.
任何帮助、评论、想法都非常感谢.
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.
示例:
这篇关于Delphi 中的自定义控件创建的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！