TDigits Komponente

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