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.