TDigits Komponente

[surfer007]

Da ich zum testen die Komponente mit
mydigit := TGfxDigits.Create(Self); zur Laufzeit erstelle gibt das dann eine Fehlermeldung "Control has no parent window" an der Stelle
Canvas.CopyRect(Rect(0,0,Width,Height), FBitmap.Canvas, Rect(0,0,Width,Height)); siehe Screenshot...

Durch Setzen des Property Parent war die Fehlermeldung dann weg. Das Paint im Konstruktor habe ich gemacht da ohne das Paint nichts passiert (wenn zur Laufzeit erzeugt!).

Ok, ich habe nun die Parent Anweisung + das Paint im Konstruktor gelöscht. Im Destruktor die Reihenfolge optimiert und die nil Anweisungen gelöscht. Das Temp Bitmap FBitmap ist nun auch Private. Klappt auch gut wenn man die Komponente auf das Formular legt und nicht zur Laufzeit erzeugt

Ist zwar nicht von Nöten, aber was ist wenn man die Komponente zur Laufzeit erzeugt? Ich habe das nun so gemacht (dazu muss die Paint Procedure Public sein):

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  mydigit := TGfxDigits.Create(Form1);
  mydigit.Parent := Form1;
  mydigit.Paint;
end;

Aktuelle Version v1.2:

Delphi-Quellcode:

{************************************************}
{ TGfxDigits Version 1.2 (16.04.2011)            }
{************************************************}

unit GfxDigits;

interface

uses
  Windows, SysUtils, Classes, Controls, Graphics, Types;

type
  TGfxDigits = class(TGraphicControl)
  private
    { Private declarations }
    FDigitsCount: Byte;
    FValue: Integer;
    FDigits: TPicture;
    FBitmap : TBitmap;
    FShowZeros: Boolean;
    procedure DigitsChanged(Sender: TObject);
    procedure SetDigits(const Value: TPicture);
    procedure SetDigitsCount(const Value: Byte);
    procedure SetValue(const Value: Integer);
    procedure SetShowZeros(const Value: Boolean);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    { Published declarations }
    property Visible;
    property Value : Integer read FValue write SetValue;
    property DigitsCount : Byte read FDigitsCount write SetDigitsCount;
    property Digits : TPicture read FDigits write SetDigits;
    property ShowZeros : Boolean read FShowZeros write SetShowZeros;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

{$R digit.RES}

procedure Register;
begin
  RegisterComponents('Samples', [TGfxDigits]);
end;

{ TGfxDigits }

constructor TGfxDigits.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FDigitsCount := 1;
  FDigits := TPicture.Create;
  FBitmap := TBitmap.Create;

  // load default bitmap from resource
  FDigits.bitmap.handle := LoadBitMap(HInstance, 'digit');

  FDigits.OnChange := DigitsChanged;
end;

destructor TGfxDigits.Destroy;
begin
  FBitmap.Free;
  FDigits.Free;
  inherited Destroy;
end;

procedure TGfxDigits.DigitsChanged(Sender: TObject);
begin
  Paint;
end;

procedure TGfxDigits.Paint;
var
  i, k, dw : Integer;
  s : string;
  SrcRect, DstRect : TRect;
begin
  inherited;

  // Value to String
  s := IntToStr(FValue);

  // AutoReSize
  if (Length(s) > FDigitsCount) then FDigitsCount := Length(s);

  dw := (FDigits.Width div 11);             // width of 1 digit
  Width := FDigitsCount * dw;               // total width
  Height := FDigits.Height;                 // total height

  // Adjust String to DigitsCount
  if Length(s) < FDigitsCount then begin
    k := FDigitsCount - Length(s);
    for i := 1 to k do begin
      s := 'x' + s;                         // eg. 98 with 3 digits becomes x98
    end;
  end;

  FBitmap.Width := Width;
  FBitmap.Height := Height;

  // Copy the numbers to the canvas
  for i := 1 to FDigitsCount do begin
    k := StrToIntDef(s[i], 10);
    if FShowZeros AND (k = 10) then k := 0;
    SrcRect := Rect(k*dw, 0, k*dw + dw, FDigits.Height);
    DstRect := Rect((i-1)*dw, 0, (i-1)*dw + dw, FDigits.Height);
    FBitmap.Canvas.CopyRect(DstRect, FDigits.Bitmap.Canvas, SrcRect);
  end;

  Canvas.CopyRect(Rect(0,0,Width,Height), FBitmap.Canvas, Rect(0,0,Width,Height));

end;

procedure TGfxDigits.SetDigits(const Value: TPicture);
begin
  FDigits.Assign(Value);
  Paint;
end;

procedure TGfxDigits.SetDigitsCount(const Value: Byte);
begin
  FDigitsCount := Value;
  Paint;
end;

procedure TGfxDigits.SetShowZeros(const Value: Boolean);
begin
  FShowZeros := Value;
  Paint;
end;

procedure TGfxDigits.SetValue(const Value: Integer);
begin
  if Value <> FValue then begin
    FValue := Value;
    Paint;
  end;
end;

end.

PS: Die uses "Types" kann man sich sparen da in "Windows" mit drin.

[DeddyH]

Zitat:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  mydigit := TGfxDigits.Create(Form1);
  mydigit.Parent := Form1;
  mydigit.Paint;
end;

-->

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  mydigit := TGfxDigits.Create(Form1);
  mydigit.Parent := self;
end;

Und in den Setter-Methoden würde ich das überall nach Muster

Delphi-Quellcode:

procedure TGfxDigits.SetValue(const Value: Integer);
begin
  if Value <> FValue then begin
    FValue := Value;
    Invalidate;
  end;
end;

machen. Es muss ja nur dann neu gezeichnet werden, wenn sich der Wert der Property auch wirklich ändern soll.

P.S.: Den Parameter eines Setters für die Property Value auch Value zu nennen ist eher kontraproduktiv.

[mkinzler]

Hier auch
mydigit := TGfxDigits.Create(Form1); in
mydigit := TGfxDigits.Create(self); ändern

Und Statt Value AValue

[DeddyH]

Stimmt, das habe ich übersehen

[surfer007]

Ich habe ein kleines Problem wenn ich ein TGfxDigits auf ein TImage32 aus der Graphics32 Sammlung lege. Zur Entwurfszeit ist alles ok (Screenshot1) aber zur Laufzeit wird das TImage32 nicht gezeichnet, es erscheint transparent d.h. alles was unter dem Form liegt ist sichtbar (Screenshot2). Was kann man da machen?