TDigits Komponente

[surfer007]

Hallo Delphi Gemeinde,

ich hatte mal eine TDigits Komponente unter D5 im Einsatz, leider nur dcu vorhanden. Die Komponente kann Zahlen grafisch mit Bitmaps darstellen. Als Resource dient ein BMP mit den Zahlen 0-9 sowie ein Leerfeld (siehe Anhang). Da der Autor auf Anfragen nicht reagiert und die Komponente nur als D5 dcu vorliegt, meine Frage: Hat jemand den Quellcode der TDigits oder kennt jemand eine vergleichbare Komponente?

Grüsse,
Surfer007

[DeddyH]

Schau doch mal bei Torry.

[Die Muhkuh]

Wobei man die auch selbst schreiben kann, wenn man nichts anderes findet. Die Bilder scheinst Du ja zu haben.

[Bummi]

Ist bei den Jedis dabei

[mz23]

Suche mal nach einer watDigit.zip Datei auf dieser Seite:

http://decoding.narod.ru/download/co...indicator.html

dann auf den Download "Скачать." klicken...
Dauert zwar alles ein bißchen, aber die Minute kann man warten:)

Mfg mz23


PS: Die Komponente ist mit Delphi Quelltext

[markus5766h]

. . . oder hier :
http://www.picsoft.de/compon.htm:wink:

[divBy0]

Bei den TMS Smooth Controls ist auch so eine Anzeige dabei, für D2009 und D2010 gibts die Smooth Controls ja bei Emba als Download.

[surfer007]

Danke für die vielen Antworten!

Ich benötige eine Digits Komponente die aus dem Vorgabe-Bitmap die Zahl darstellt, nicht irgend ein Digit sondern BMP Digits.

- watDigit ist ohne BMP
- Jedi JvgDigits ist ohne BMP
- Simons TLEDDisplay ist ohne BMP
- TAdvSmoothLEDLabel ist ohne BMP

> Wobei man die auch selbst schreiben kann, wenn man nichts anderes findet.
> Die Bilder scheinst Du ja zu haben.

Ja, sieht so aus als muss ich mir das Teil selber schreiben, wobei ich noch NIE eine Komponente geschrieben habe :(
Ich dachte ich komme einfacher zu so einer Digits Komponente die ein BMP für die Zahlen verwendet.

Ansatz:
Property DigitsImg, vorgabe wie oben, 0-9 und Leerfeld.

Dann Copy Positionen (Rect?!) für jede Zahl berechnen.
DigitsImg.Width div 11 ist die Breite jeder Zahl
Höhe ist DigitsImg.Height
Position der 0 ist 0
Position der 1 ist 0 + 1x Breite
Position der 2 ist 0 + 2x Breite
usw...

Dann die gewünschte Zahl (Property Value) Stelle für Stelle ermitteln und copy ins sichtbare Image.
Da ich ab und zu mit GR32 arbeite (Anfänger!!!) werde ich wohl das mit GR32 Bitmap versuchen.

Ok, für ein paar Anregungen um solch eine Komponente selber zu schreiben wäre ich dankbar...

Grüsse,
Surferr007

[Klaus01]

Guten Morgen,

vielleicht geht auch dieser Weg...

TimageList mit den BMPs aller Ziffern von 0 bis 9 (16 Segment)

Die BMPs kannst Du dir ja selber machen.
Einen 16 Segement TTF Font suchen und installieren.
http://web.utanet.at/ascherst/files/asegment.ttf
http://web.utanet.at/ascherst/files/fx850.ttf

Mit einem Grafikprogramm die BMPs erstellen
und dann in die ImageList laden.

Grüße
Klaus

[rollstuhlfahrer]

Oder du zerschnippelst das Bild aus #1. Dann hast du schon alle deine BMPs. Diese kannst du dann wie schon im Post drüber angegeben in eine TImageList zusammenführen.

Bernhard

[surfer007]

Ich habe nun eine eigene Digits Komponente erstellt.
Hier der Source Code:

Code:

{************************************************}
{ TGfxDigits Version 1.1 (15.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;
    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 }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; 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);
  parent := TWINControl(AOwner);

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

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

  FDigits.OnChange := DigitsChanged;
  Paint;
end;

destructor TGfxDigits.Destroy;
begin
  FDigits.Free;
  FDigits := nil;
  inherited Destroy;
end;

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

procedure TGfxDigits.Paint;
var
  i, k, dw : Integer;
  s : string;
  SrcRect, DstRect : TRect;
  bBitmap : TBitmap;
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;

  bBitmap := TBitmap.Create;
  bBitmap.Width := Width;
  bBitmap.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);
    bBitmap.Canvas.CopyRect(DstRect, FDigits.Bitmap.Canvas, SrcRect);
  end;

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

  bBitmap.Free;

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
  FValue := Value;
  Paint;
end;

end.

Da dies meine erste Komponente ist bitte mal den Code anschauen und evtl. Verbesserungsvorschläge machen!

Grüsse,
Surfer007

[shmia]

Ich würde das Bitmap, dass du in

Delphi-Quellcode:

procedure TGfxDigits.Paint

verwendest, nicht jedesmal neu erzeugen und freigeben.
Die Paint-Methode kann sehr häufig aufgerufen werden und erzeugt so "Stress" für den Memory-Manager von Delphi als auch für Windows (Handle erzeugen/zerstören).

PS:

Delphi-Quellcode:

procedure TGfxDigits.SetValue(const Value: Integer);
begin
  if Value<>FValue then // nur wenn sich der Wert ändert etwas tun
  begin
    FValue := Value;
    Paint;
  end;
end;

[surfer007]

Ok, das Temp Bitmap ist nun Global und SetValue arbeitet nur bei einer Änderung

Delphi-Quellcode:

{************************************************}
{ TGfxDigits Version 1.1 (15.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;
    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 }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; 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;

var
  bBitmap : TBitmap;

procedure Register;

implementation

{$R digit.RES}

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

{ TGfxDigits }

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

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

  bBitmap := TBitmap.Create;

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

  FDigits.OnChange := DigitsChanged;
  Paint;
end;

destructor TGfxDigits.Destroy;
begin
  bBitmap.Free;
  bBitmap := nil;
  FDigits.Free;
  FDigits := nil;
  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;

  bBitmap.Width := Width;
  bBitmap.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);
    bBitmap.Canvas.CopyRect(DstRect, FDigits.Bitmap.Canvas, SrcRect);
  end;

  Canvas.CopyRect(Rect(0,0,Width,Height), bBitmap.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.

[DeddyH]

Mach doch aus der globalen Variablen ein privates Feld der Komponente. Und benutze bitte Delphi- statt Code-Tags.

[sx2008]

Ich sehe da noch zwei weitere Fehler im Konstruktor (aber keine Bange, das wird schon noch).

1. Problem: der Owner und das Property Parent sind nicht zwingend identisch
Parent wird automatisch von der VCL gesetzt, sobald man ein Control auf einem Formular
platziert.
Das bedeutet also, dass ein Control das Property Parent nicht selbst zuweisen darf;
das erledigt die VCL von Aussen.

Delphi-Quellcode:

constructor TGfxDigits.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  parent := TWINControl(AOwner);  // Zeile weglassen

2. Problem: Methode Paint wird im Konstruktor aufgerufen,
obwohl das Control zu diesem Zeitpunkt noch gar nicht sichtbar ist

Delphi-Quellcode:

constructor TGfxDigits.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
....
  FDigits.OnChange := DigitsChanged;
  Paint;  // Zeile weglassen
end;

Und dann noch eine Unschönheit im Destruktor.
Das explizite Setzen von FDigits := nil ist sinnlos, da ja FDigits direkt vom dem "Tode" steht.
Es besteht keine Gefahr, dass FDigits noch irgendwie nachdem das Objekt der Klasse TGfxDigits destroyed wurde noch angesprochen wird.
Ich empfehle, die Unterobjekte FBitmap und FDigits in umgekehrter Reihenfolge freizugeben wie sie im Konstruktor angelegt wurde.
Dieses Freigeben in umgekehrter Reihenfolge gilt ganz generell für alle Objekte und Resourcen

Delphi-Quellcode:

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

[surfer007]

Da ich zum testen die Komponente mit

Delphi-Quellcode:

mydigit := TGfxDigits.Create(Self);

zur Laufzeit erstelle gibt das dann eine Fehlermeldung "Control has no parent window" an der Stelle

Delphi-Quellcode:

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

Delphi-Quellcode:

mydigit := TGfxDigits.Create(Form1);

in

Delphi-Quellcode:

mydigit := TGfxDigits.Create(self);

ändern

Und Statt Value AValue

[DeddyH]

Stimmt, das habe ich übersehen :oops:

[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?