GraphicsContainer

[EWeiss]

Hier mal die Funktion.

Keine Ahnung was da soviel CPU last fabriziert

Delphi-Quellcode:

function TAnimatePng.DrawPngFrame(PngImage: Cardinal; FrameNum: integer; DC: HDC): integer;
var
  PngGraphics: Cardinal;
  PngFrameRect: TGPRectF;
  FrameWidth: integer;
  FrameHeight: integer;
  srcUint: GpUnit;
  rc: TRect;
  rw: TRect;
  TargetRatio: Double;
  IsRelationship: Double;
  w, h, X, Y: integer;
  hTempDC: HDC;
  hBitmapTemp: HBitmap;
  hBitmapOld: HBitmap;
  UseBackColor: ARGB;

begin

  Result := 1;

  srcUint := UnitPixel;
  hTempDC := CreateCompatibleDC(DC);

  If GDIP_GetImageBounds(PngImage, @PngFrameRect, srcUint) = OK then
  begin
    GetWindowRect(GraphicContainer, rw);
    GetClientRect(GraphicContainer, rc);

    hBitmapTemp := SKAERO_CreateDIBSection(hTempDC, rc.Right, rc.Bottom, 32);
    hBitmapOld := SelectObject(hTempDC, hBitmapTemp);

    UseBackColor := MakeColor(32, 0, 100, 128);

    GDIP_DrawGradientVertical(hTempDC, 1, 1, rc.Right, rc.Bottom, UseBackColor, UseBackColor);

    if GDIP_CreateFromHDC(hTempDC, PngGraphics) = OK then
    begin
      try
        // Gif Zentrieren
        if gp.FrameCount = 0 then
          FrameWidth := round(PngFrameRect.Width)
        else
          FrameWidth := round(PngFrameRect.Width) div gp.FrameCount;

        FrameHeight := round(PngFrameRect.Height);
        if (FrameWidth > rc.Right) or (FrameHeight > rc.Bottom) then
        begin
          IsRelationship := FrameWidth / FrameHeight;
          TargetRatio := rc.Right / rc.Bottom;

          if IsRelationship > TargetRatio then
          begin
            w := rc.Right;
            h := rc.Right div round(IsRelationship);
          end
          else if IsRelationship < TargetRatio then
          begin
            h := rc.Bottom;
            w := rc.Bottom * round(IsRelationship);
          end
          else
          begin
            w := rc.Right;
            h := rc.Bottom;
          end;
        end
        else
        begin
          w := FrameWidth;
          h := FrameHeight;
        end;

        X := (rc.Right - w) div 2;
        Y := (rc.Bottom - h) div 2;

        // einzelnes Bild auf Graphicsobjekt zeichnen
        if gp.FrameCount = 0 then
          GDIP_DrawImageRect(PngGraphics, PngImage, X, Y, w, h)
        else
          GDIP_DrawImageRectRectI(PngGraphics, PngImage, X, Y, w, h, w * integer
              (CurPngPlayInfo.PngFrame) - w, 0, w, h, 2, nil, False, nil);

        CurPngPlayInfo.PngDelay := TimerInterval;
        CurPngPlayInfo.PngFrame := FrameNum + 1;
        CurPngPlayInfo.PngLoop := LoopCount - 1;
        CurPngPlayInfo.PngLoops := FrameLoopCount;

        // Ausgabe von Infos
        ShowPngPlayInfos(CurPngPlayInfo);

        // Nur Rendern wenn die Classe AnimatePng initialisiert ist
        if Assigned(AnimatePng) then
        begin
          w := 150;
          h := 60;
          // String Zentrieren
          case Length(IntToStr(AnimatePng.TimerInterval)) of
            1:
              X := (rc.Right - w) div 2 + 45;
            2:
              X := (rc.Right - w) div 2 + 30;
            3:
              X := (rc.Right - w) div 2 + 10;
          end;
          Y := rc.Bottom - h;
          rw.Right := w;
          rw.Bottom := h;
          rw.Left := X;
          rw.Top := Y;

          if not(gp.FrameCount = 0) and (Alpha > 0) then
            // String zeichnen
            GDIP_DrawTextToDC(hTempDC, IntToStr(AnimatePng.TimerInterval), rw, MakeColor
                (Alpha, 3, 123, 250), 'LCDDisplayCapsSSK', 60, FontStyleBold, -1, 0,
              LCDDisplayCapsSSK);
        end;

        BitBlt(DC, rc.Left, 0, rc.Right, rc.Bottom, hTempDC, rc.Left, 0, SRCCOPY);

      finally
        // Graphicsobjekt löschen
        GDIP_DeleteGraphics(PngGraphics);

        SelectObject(hTempDC, hBitmapOld);
        DeleteObject(hBitmapTemp);
        DeleteDC(hTempDC);
      end;
    end;
  end;

end;

gruss