GetDC mit einer Komponente

[halinchen]

Hi!

Ich möchte in mein Programm eine Animation einer GroupBox einfügen.
Die GroupBox soll sich immer weiter verkleinern, bis die Höhe 0 ist und dann soll es die Werte ändern und dann die GruopBox wieder "ausfahren".
Das ist auch nicht mein Problem. Allerdings flimmert es. (Auch mit DoubleBuffered:=true).

Deswegen dachte ich mir, ich kopier das Bild der GroupBox und lass das Bild rein- und rausklappen.
Reinzu geht es. Aber rauszu nicht. Und zwar muss die GroupBox sichtbar sein damit sie "abfotografiert" werden kann.

Delphi-Quellcode:

procedure TfrmProduct.AnimateUp(Speed:Integer);
var
i:Integer;
begin
While img.Height > 0 do begin
    img.Height:=img.Height-1;
    For i := 0 to Speed do Application.ProcessMessages;
end;
end;

procedure TfrmProduct.AnimateDown(Speed:Integer);
var
i:Integer;
begin
While img.Height < frmProduct.ClientHeight - 5 do begin
    img.Height:=img.Height+1;
    For i := 0 to Speed do Application.ProcessMessages;
end;
end;

procedure TfrmProduct.Button1Click(Sender: TObject);
var
bmp:TBitmap;
begin
bmp := TBitmap.Create;
GetImage(bmp);
img.Picture.bitmap.Assign(NIL);
img.picture.bitmap := bmp;
img.stretch := false;
img.Left := GroupBox1.Left;
img.Top := GroupBox1.Top;
img.Width := GroupBox1.Width;
img.height := GroupBox1.height;
img.Visible := true;
GroupBox1.Visible := false;
AnimateUp(10000);
Case TControl(Sender).Tag of
...
end;
Image1.Picture.Bitmap.Assign(NIL); 
Image1.Picture.Bitmap.Height := 48;
ImageList1.GetBitmap(TControl(Sender).Tag,Image1.Picture.Bitmap);
GetImage(bmp);
img.Picture.bitmap.Assign(NIL);
img.picture.bitmap := bmp;
img.height := 0;
bmp.Free;
AnimateDown(10000);
img.Visible := false;
GroupBox1.Visible := true;
end;


procedure TfrmProduct.GetImage(var bmp:TBitmap);
var
 DCanvas: TCanvas;
 DHandle: HWND;
begin
 DHandle:=GetDC(GroupBox1.Handle);
 if DHandle=0 then begin
    exit;
 end;
 DCanvas := TCanvas.Create;
 DCanvas.Handle := DHandle;
 bmp := Tbitmap.Create;
 bmp.Assign(NIL);
 bmp.Height := GroupBox1.Height;
 bmp.Width := GroupBox1.Width;
 bmp.Canvas.CopyRect(Rect(0,0,GroupBox1.Width,GroupBox1.Height),DCanvas,Rect(0,0,GroupBox1.Width,GroupBox1.Height));
 DCanvas.Free;
end;

Ich könnte nun die GroupBox anzeigen lassen und ProcessMessages aufrufen, damit sie gezeichnet wird: Aber dann erscheint immer kurz die GroupBox und geht dann weg und dann klappt es auf.
Wie mach ich es besser?

[sirius]

Lass doch das GetImage beim zweiten mal weg. Du hast es doch schon im Speicher. Ausserdem könntest du mal ein TBitmap.create weg nehmen. Du erzeugst nämlich Speicherlöcher.

[halinchen]

Zitat:

Zitat von sirius

Ausserdem könntest du mal ein TBitmap.create weg nehmen. Du erzeugst nämlich Speicherlöcher.

Das hatte ich noch gar nicht gesehen...

Zitat:

Zitat von sirius

Lass doch das GetImage beim zweiten mal weg.

Das wird nicht gehen. Ich tausche den Inhalt der Komponenten in der GroupBox aus. Somit muss ich mit GetImage das Bild nochmal holen, sonst würde der Inhalt alt bleiben.

[sirius]

Ich glaub das geht nicht. Kannst du die Groupbox nicht irgendwie schonmal zu einem anderen Zeitpunkt abfotografieren?

[halinchen]

ich hab mir fast schon gedacht, dass es nicht geht... :|
Naja, mal gucken was sich machen lässt.

Ich hab's vorhin vergessen: Danke für deine Antwort. :hi:

[halinchen]

:cyclops: *PUSH* :cyclops:

So wie ich das jetzt verstanden habe, heißt das, dass meine Variante (Die GroupBox abzufotografieren) nicht funktioniert.
Kennt jemand noch eine andere Variante, um sowas hinzubekommen.

ich hab schon mal im Forum nach flackern und sowas gesucht, aber meistens funktioniert das mit DoubleBuffered := true :?

[halinchen]

Ich habs:

Delphi-Quellcode:

procedure TfrmProduct.AnimateUp(Speed:Integer);
var
i:Integer;
begin
While img.Height > 0 do begin
    img.Height:=img.Height-1;
    For i := 0 to Speed do Application.ProcessMessages;
end;
end;

procedure TfrmProduct.AnimateDown(Speed:Integer);
var
i:Integer;
begin
While img.Height < frmProduct.ClientHeight - 5 do begin
    img.Height:=img.Height+1;
    For i := 0 to Speed do Application.ProcessMessages;
end;
end;

procedure TfrmProduct.Button1Click(Sender: TObject);
var
bmp:TBitmap;
begin
bmp := TBitmap.Create;
GetImage(bmp);
img.Picture.bitmap.Assign(NIL);
img.picture.bitmap := bmp;
img.stretch := false;
img.Left := GroupBox1.Left;
img.Top := GroupBox1.Top;
img.Width := GroupBox1.Width;
img.height := GroupBox1.height;
img.Visible := true;
GroupBox1.Visible := false;
AnimateUp(100000);
Case TControl(Sender).Tag of
0:begin
  Label1.Caption := L1_0;
  Label2.Caption := L2_0;
  end;
1:begin
  Label1.Caption := L1_1;
  Label2.Caption := L2_1;
  end;
2:begin
  Label1.Caption := L1_2;
  Label2.Caption := L2_2;
  end;
3:begin
  Label1.Caption := L1_3;
  Label2.Caption := L2_3;
  end;
end;
Image1.Picture.Bitmap.Assign(NIL);
Image1.Picture.Bitmap.Height := 48;
ImageList1.GetBitmap(TControl(Sender).Tag,Image1.Picture.Bitmap);
GroupBox1.Visible := true;
repaint;
GetImage(bmp);
GroupBox1.Visible := false;
img.Picture.bitmap.Assign(NIL);
img.picture.bitmap := bmp;
img.height := 0;
AnimateDown(100000);
img.Visible := false;
GroupBox1.Visible := true;
bmp.Free;
end;

procedure TfrmProduct.FormCreate(Sender: TObject);
begin
{frmProduct.DoubleBuffered := true;
GroupBox1.DoubleBuffered := true;} //Muss false sein, sonst sieht man während der Animation kurz die große GroupBox.
end;


procedure TfrmProduct.GetImage(var bmp:TBitmap);
var
 DCanvas: TCanvas;
 DHandle: HWND;
begin
 DHandle:=GetDC(GroupBox1.Handle);
 if DHandle=0 then begin
    exit;
 end;
 DCanvas := TCanvas.Create;
 DCanvas.Handle := DHandle;
 bmp.Assign(NIL);
 bmp.Height := GroupBox1.Height;
 bmp.Width := GroupBox1.Width;
 bmp.Canvas.CopyRect(Rect(0,0,GroupBox1.Width,GroupBox1.Height),DCanvas,Rect(0,0,GroupBox1.Width,GroupBox1.Height));

end;

Durch das Repaint sieht man komischerweise die immernoch ausgeklappte GroupBox während der Animation nicht.
Einziger Nachteil: Wenn man das Programm hinter ein anderes Fenster setzt, kopiert es nicht die GroupBox in bmp, sondern den Teil des Screen, wo die GroupBox wäre.

[SirThornberry]

Nutze anstelle von Repaint lieber Invalidate, das verhindert in den meisten Fällen übermäßiges flackern.

[halinchen]

Invalidate aus der Delphi Hilfe.

Zitat:

Das eigentliche Neuzeichnen erfolgt erst beim Aktualisieren des Steuerelements. Rufen Sie Repaint auf, um ein sofortiges Neuzeichnen zu veranlassen.

Allerdings muss ich das Element sofort neuzeichnen, sonst bleibt mein Bitmap leer.

Trotzdem Danke! :thumb: