TDigits Komponente

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