nonVCL - Bitmap in Bitmap kopieren

[Olli]

BITTE NEU HERUNTERLADEN!!!

So, hier meine Variante. Ich habe mal schamlos Flocke's Code weiterverwertet.
Habe ihn noch schnell auf Thread umgestellt (hatte zuvor mit Timer getestet).

In Sachen Thread hat sich ein wenig geändert und außerdem werden alle (Einzel-)Bitmaps der Animationen nun im Speicher gehalten. Man könnte das so optimieren, daß nur jeweils eine "Zeile" im Speicher bliebe. Die Arrays beginnen nun sinnvollerweise bei 0 und die Animationen werden bis auf die Bitmaps schon vorher initialisiert (keine Zuweisung mehr).

Hinweis: Die Transparenz habe ich komplett entfernt, da bei mir die Funktion nicht deklariert war und es so schneller ging. Da es nun funktioniert, sollte das das geringste Problem sein

Zum Erstellen der Einzelbitmaps ...

Delphi-Quellcode:

function PrepareAnimations(var Anim: TAnimation): Boolean;
var
  i: TAniType;
  j: Integer;
  MemDC, MemDC2: HDC;
  oldBitmap,
    oldBitmap2,
    ResBitmap: HBITMAP;
begin
  Result := True;
  // Bitmap der Animationen laden
  ResBitmap := LoadBitmap(hInstance, MAKEINTRESOURCE(10));
  // DCs erzeugen
  MemDC := CreateCompatibleDC(0);
  MemDC2 := CreateCompatibleDC(0);
  for i := aniCat to aniGreenBounce do
    for j := 0 to Anim[i].MaxImages - 1 do
    begin
      Anim[i].Bitmaps[j] := CreateCompatibleBitmap(MemDC, BMPWIDTH, BMPHEIGHT);

      // Korrekte Bitmaps selektieren
      oldBitmap := SelectObject(MemDC, Anim[i].Bitmaps[j]);
      oldBitmap2 := SelectObject(MemDC2, ResBitmap);

      // Zeichnen auf MemDC von dem korrekten Offset in MemDC2 aus
      BitBlt(MemDC, 0, 0, BMPWIDTH, BMPHEIGHT, MemDC2, j * BMPWIDTH, Anim[i].Offset * BMPHEIGHT, SRCCOPY);

      // DC "freigeben" indem die alte Bitmap zurückselektiert wird
      SelectObject(MemDC2, oldBitmap2);
      // Alte Bitmap zurückselektieren und somit die Änderung in Anim[i].Bitmaps[j] schreiben
      SelectObject(MemDC, oldBitmap);
    end;

  // DCs freigeben
  DeleteDC(MemDC2);
  DeleteDC(MemDC);

  // Resourcenbitmap freigeben
  DeleteObject(ResBitmap);
end;

function UnprepareAnimations(var Anim: TAnimation): Boolean;
var
  i: TAniType;
  j: Integer;
begin
  Result := True;
  for i := aniCat to aniGreenBounce do
    for j := 0 to Anim[i].MaxImages - 1 do
      if (Anim[i].Bitmaps[j] <> 0) then
      begin
        // Bitmap freigeben
        DeleteObject(Anim[i].Bitmaps[j]);
        Anim[i].Bitmaps[j] := 0;
      end;
end;

Um "weiterzuschalten":

Delphi-Quellcode:

function SetNextAnimationStep(var Anim: TAnimation; hwnd: HWND; anitype: TAniType): Boolean;
begin
  Result := True;
  // Eins hochsetzen
  inc(Anim[anitype].Current);
  // Zurücksetzen bei Overflow
  if (Anim[anitype].Current >= Anim[anitype].MaxImages) then
    Anim[anitype].Current := 0;
  // Neuen Animationsschritt setzen
  SendMessage(hwnd, STM_SETIMAGE, IMAGE_BITMAP, Anim[anitype].Bitmaps[Anim[anitype].Current]);
end;

function MyTimerThreadFunc(Parameter: Pointer): Integer;
var
  parms: PThreadParamBlock;
begin
  parms := Parameter;
  if (Assigned(parms) and Assigned(parms^.Anim) and IsWindow(parms^.TargetWnd)) then
    while (not parms^.ExitThread) do
    begin
      SetNextAnimationStep(parms^.Anim^, parms^.TargetWnd, parms^.AnimType);
      Sleep(parms^.Anim^[parms^.AnimType].Times[0]);
    end;
  Result := 0; // Set up a 0 return value
  EndThread(0); // End the thread
end;

PS: Sorry, aber ich mußte einen Sourceformatter verwenden. Irgendwie kam ich mit weiten Teilen deiner Formatierung überhaupt nicht klar.

BITTE NEU HERUNTERLADEN!!! Verwendung: einfach die Datei durch die alte im obigen Archiv von Matti ersetzen.