Farbe zur Laufzeit verändern?

[DeddyH]

Ich habe auch mal schnell was zusammengestrickt. Statt des gelben Rechtecks würde man dann eben die Grafik zeichnen.

Delphi-Quellcode:

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TDingens = class(TCustomControl)
  strict private
    FAniTimer: TTimer;
    FCurrentStep: integer;
    FIncrement: integer;
    procedure DoOnTimer(Sender: TObject);
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TfrmTest = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FDingens: TDingens;
  public
    { Public-Deklarationen }
  end;

var
  frmTest: TfrmTest;

implementation

{$R *.dfm}

const
  X_OFFSET = 10;

{ TDingens }

procedure TDingens.CMMouseEnter(var Msg: TMessage);
begin
  inherited;
  FIncrement := abs(FIncrement);
  FAniTimer.Enabled := true;
end;

procedure TDingens.CMMouseLeave(var Msg: TMessage);
begin
  inherited;
  FIncrement := -abs(FIncrement);
  FAniTimer.Enabled := true;
end;

constructor TDingens.Create(AOwner: TComponent);
begin
  inherited;
  FIncrement := 10;
  FCurrentStep := X_OFFSET;
  FAniTimer := TTimer.Create(self);
  FAniTimer.Enabled := false;
  FAniTimer.Interval := 10;
  FAniTimer.OnTimer := DoOnTimer;
  Width := 75;
  Height := 25;
end;

destructor TDingens.Destroy;
begin
  FAniTimer.Enabled := false;
  inherited;
end;

procedure TDingens.DoOnTimer(Sender: TObject);
begin
  inc(FCurrentStep, FIncrement);
  if FCurrentStep > Width - X_OFFSET then
    begin
      FAniTimer.Enabled := false;
      FCurrentStep := Width - X_OFFSET;
    end
  else if FCurrentStep < X_OFFSET then
    begin
      FAniTimer.Enabled := false;
      FCurrentStep := X_OFFSET;
    end;
  Invalidate;
end;

procedure TDingens.Paint;
begin
  inherited;
  Canvas.Brush.Color := clBlue;
  Canvas.FillRect(Rect(0, 0, Width, Height));
  Canvas.Brush.Color := clYellow;
  Canvas.FillRect(Rect(0, 0, FCurrentStep, Height));
end;

procedure TfrmTest.FormCreate(Sender: TObject);
begin
  FDingens := TDingens.Create(self);
  FDingens.Left := 20;
  FDingens.Top := 20;
  FDingens.Parent := self;
end;

Um die Grafik reinzuschieben, muss man ja nur die X-Koordinate negativ initialisieren und dann im Timer in Einzelschritten an die 0 heranführen.