FadeIn / FadeOut Problem

[WorstNightmare]

Hallo,

ich möchte gerne ein SlideShow-Programm schreiben und benutze für die Ein/Ausblendung die Routinen aus diesem Thread.

Allerdings wird immer ein Teil rechts nicht korrekt ein- und ausgeblendet, das sind ca. 200 von 1024 Pixeln und das ist dann sehr störend.

Delphi-Quellcode:

procedure TSmoothSlideThread.FadeIn;
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  // Bitmaps vorbereiten / Preparing the Bitmap //
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;  // oder pf24bit / or pf24bit //
    Bitmap.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'TempImage.bmp');
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
      for step := 0 to 32 do
      begin
        for y := 0 to (Bitmap.Height - 1) do
        begin
          BaseRow := BaseBitmap.Scanline[y];
          // Farben vom Endbild holen / Getting colors from final image //
          Row := Bitmap.Scanline[y];
          // Farben vom aktuellen Bild / Colors from the image as it is now //
          for x := 0 to (Bitmap.Width - 1) do
          begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;

        Form1.Img.Canvas.Draw(0, 0, Bitmap);   // neues Bild ausgeben / Output new image //
        InvalidateRect(Form1.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;

procedure TSmoothSlideThread.FadeOut;
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  // Bitmaps vorbereiten / Preparing the Bitmap //
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;  // oder pf24bit / or pf24bit //
    Bitmap.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'TempImage.bmp');
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
      for step := 32 downto 0 do
      begin
        for y := 0 to (Bitmap.Height - 1) do
        begin
          BaseRow := BaseBitmap.Scanline[y];
          // Farben vom Endbild holen / Getting colors from final image //
          Row := Bitmap.Scanline[y];
          // Farben vom aktuellen Bild / Colors from the image as it is now //
          for x := 0 to (Bitmap.Width - 1) do
          begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;

        Form1.Img.Canvas.Draw(0, 0, Bitmap);   // neues Bild ausgeben / Output new image //
        InvalidateRect(Form1.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;

Dies sind die beiden Methoden und in TempImage ist ein 1024 x 768 großes Bitmap, das Bild wurde von Delphi auf die Zahl runtergerechnet.

Delphi-Quellcode:

procedure ResizeImage(newWidth, newHeight: Integer; srcBmp, destBmp: TBitmap);
begin
  SetStretchBltMode(destBmp.Canvas.Handle, Halftone);
  StretchBlt(destBmp.Canvas.Handle, 0, 0, newwidth, newheight, srcBmp.Canvas.Handle, 0, 0, srcBmp.Width, srcBmp.Height, SRCCOPY);
end;

Ich denke es ist nicht das Bild, in der Windows Vorschau wird es richtig angezeigt, ist also ein Fehler in den beiden proceduren? :?

Grüße

[Corpsman]

Also das einzige was ich so beim Überfliegen sehe.

Du must immer PF24Bit nehmen, und ich würde das auch erst nach dem Laden setzen.

Probier mal das.

[WorstNightmare]

Vielen Dank, daran lag es! :dp: