Image - Keine Reaktion

[Merlin1988]

Delphi-Quellcode:

unit Unit1; 

interface 

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

type 
  TForm1 = class(TForm) 
    Image1: TImage; 
    Timer1: TTimer; 
    procedure FormCreate(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  Form1      : TForm1; 
  x          : Integer; 
  Background : TBitmap; 
  Front      : TBitmap; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Background := TBitmap.Create; 
  Background.Width := 200; 
  Background.Height := 200; 
  Background.Canvas.Brush.Color := clgreen; 
  Background.Canvas.FillRect(Classes.Rect(0,0,200,200)); 
end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  inc(x); 
  Front := TBitmap.Create; 
  Front.Width := 200; 
  Front.Height := 200; 
  Front.Assign(Background); 
  Front.Canvas.TextOut(1,1,IntToStr(x)); 

  BitBlt(Image1.Canvas.Handle,0,0,200,200,Front.Canvas.Handle,0,0,SRCCOPY); 

  {nur als Test, ob logisch irgendwas falsch ist} 
  BitBlt(Canvas.Handle,0,0,200,200,Front.Canvas.Handle,0,0,SRCCOPY); 


  Front.Free; 
end; 

end.

Eigentlich sollte das Image einen grünen Hintergrund haben, auf dem einfach (das soll nur zum Test sein) eine Zahl, die sich stetig erhöht, angezeigt wird. Dummerweise ist immer nur das erste Bild zu sehen (= grüner Hintergrund mit Aufschrift '1').
Auf dem Canvas der Form läuft die Zahl mit dem selben Verfahren aber !!??? (=> siehe Kommentar im Quelltest)

(Das Hantieren mit zwei Bitmaps kommt daher, da das eine nur den Hintergrund erhält und das andere diesen lädt und den Vordergrund malt.)

[xaromz]

Hallo,

Du must dem Image sagen, dass es sich neu zeichnen soll. Wenn Du das Bitmap manipulierst bekommt das Image nichts mit. Beim ersten Aufruf wird das Bitmap erzeugt, das kriegt es mit.

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  inc(x); 
  Front := TBitmap.Create; 
  Front.Width := 200; 
  Front.Height := 200; 
  Front.Assign(Background); 
  Front.Canvas.TextOut(1,1,IntToStr(x)); 

  BitBlt(Image1.Canvas.Handle,0,0,200,200,Front.Canvas.Handle,0,0,SRCCOPY); 
  Image1.Refresh; // <----- das hier

  {nur als Test, ob logisch irgendwas falsch ist} 
  BitBlt(Canvas.Handle,0,0,200,200,Front.Canvas.Handle,0,0,SRCCOPY); 


  Front.Free; 
end;

Gruß
xaromz

// Edit: Willkommen :party:

[Luckie]

Und bitte missbrauch ein TImage nicht zum Zeichnen, dazu ist die TPaintbox da.

[Luckie]

So würde ich es amchen:

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
    MyBmp: TBitmap;
    Counter: Cardinal;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Counter := 0;
  MyBmp := TBitmap.Create;
  MyBmp.Canvas.Brush.Color := clGreen;
  MyBmp.Width := Width;
  MyBmp.Height := Height;
  MyBmp.Canvas.Font.Name := 'Tahoma';
  MyBmp.Canvas.Font.Size := 36;
  MyBmp.Canvas.Font.Color := clRed;
  MyBmp.Canvas.Font.Style := [fsBold];
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(MyBmp);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  MyBmp.Width := 0;
  MyBmp.Height := 0;
  MyBmp.Width := Width;
  MyBmp.Height := Height;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  rect: TRect;
begin
  Inc(Counter);
  rect := PaintBox1.BoundsRect;
  DrawText(MyBmp.Canvas.Handle, PChar(IntToStr(Counter)), length(IntToStr(Counter)), rect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
  InvalidateRect(Handle, nil, False);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  BitBlt(PaintBox1.Canvas.Handle, 0, 0, PaintBox1.Width, PaintBox1.Height, MyBmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

[Merlin1988]

1. Danke für die Begrüssung
2. Danke für die Hilfen
3. Wenn ich das jetzt aber in eine eigene Komponente einbauen will,(abgeleitet von TPainbox), meckert er "Control has no parent window" wenn ich zeichnen will.

Delphi-Quellcode:

unit TestPaintbox;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ExtCtrls;

type
  TTestPaintbox = class(TPaintbox)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Upgrade;
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('My Own', [TTestPaintbox]);
end;

{ TTestPaintbox }

constructor TTestPaintbox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Upgrade;
end;

destructor TTestPaintbox.Destroy;
begin
  inherited Destroy;
end;

procedure TTestPaintbox.Upgrade;
begin
    Self.Canvas.Ellipse(50,50,60,60);
end;

end.

Das war für mich der Vorteil mit Image zu arbeiten, da dort diese Fehlermeldung nicht kam.

[Khabarakh]

Du arbeitest noch im Create mit der Canvas der Paintbox, diese hat aber noch kein Parent, auf dem sie die Änderung darstellen könnte. Prüfe also vor dem Benutzen der Canvas, ob Parent schon zugewiesen ist. Wenn du nur auf dem OffScreenBitmap zeichnest und dieses in Paint auf die Canvas kopierst, brauchst du auch die Überprüfung nicht.

[Kroko1999]

überschreibe die proc CreateWnd und setze dort dein Upgrade!

[Merlin1988]

danke schön für die Antworten.
mit

Delphi-Quellcode:

  if Assigned(Self.Parent) then
    Self.Canvas.Ellipse(50,50,60,60);

funktioniert es !