Creación de control personalizado en Delphi

delphi-7 custom-component

Question

Solía ​​hacer esto en un formulario y lo creé como 10 veces, estaba bien, hasta que intenté pasar este número, comenzó a consumir recursos del sistema, ¿de todos modos podría crear un componente como este? para un proyecto Simulador, 8bits necesarios para indicar el valor del registro en binario

cualquier ayuda, comentarios, ideas son realmente apreciados. ty.

Answer 1

Estaba un poco aburrido, y quería jugar con mi nuevo Delphi XE, así que hice un componente para ti. Debería funcionar en el viejo Delphi, está bien.

Puede descargarlo aquí: BitEditSample.zip

¿Como funciona?

• Hereda del control personalizado, por lo que puede enfocar el componente.
• Contiene una variedad de etiquetas y casillas de verificación.
• El número de bit se almacena en la propiedad "etiqueta" de cada casilla de verificación
• Cada casilla de verificación tiene un controlador de cambio que lee la etiqueta, para ver qué bit debe manipularse.

Cómo usarlo

• Tiene un "valor" de propiedad. Si lo cambia, las casillas de verificación se actualizarán.
• Si hace clic en las casillas de verificación, el valor cambiará.
• Establezca la propiedad "título" para cambiar el texto que dice "Registrar X:"
• Puede crear un controlador de eventos "onchange", de modo que cuando el valor cambie (debido a un mouseclick por ejemplo), se le notifique.

El archivo zip contiene un componente, un paquete y una aplicación de muestra (incluido un exe compilado, por lo que puede probarlo rápidamente).

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.

Recursos

Supongo que el problema al que se enfrentaba el OP es un ciclo de retroalimentación, donde dos manejadores de eventos se llaman entre sí.

Otros recursos no parecen aumentar de forma inusual cuando se utilizan más editores de bits. Lo he probado con una aplicación con muchas instancias del componente de edición de bit:

 [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 

Answer 2

Estoy de acuerdo en que no debería haber un problema con cien casillas de verificación en un formulario. Pero, por pura diversión, acabo de escribir un componente que hace todo el dibujo de forma manual, por lo que solo hay un identificador de ventana por control (es decir, por cada ocho casillas de verificación). Mi control funciona tanto con temas visuales habilitados como con temas desactivados. También tiene doble amortiguación y está completamente libre de parpadeos.

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.

Ejemplo:

Ejemplo de control del editor de bytes http://privat.rejbrand.se/byteedit.png
(Alta resolución)

Answer 3

Usted tiene estas opciones, en orden de dificultad:

1. Crea un marco y reutilízalo
2. Crea un control compuesto (usando tal vez un panel, etiquetas y casillas de verificación). Cada control manejará su propia interacción teclado / mouse.
3. Cree un control completamente nuevo: todos los elementos se dibujan con las API adecuadas y el código de control maneja todas las interacciones entre teclado y mouse.