Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Bitmap Fade in and out Problem (https://www.delphipraxis.net/99602-bitmap-fade-out-problem.html)

sexmagic 14. Sep 2007 15:34


Bitmap Fade in and out Problem
 
Hallo Leute,

war lange Zeit außer Gefecht und nun bin ich wieder da, hab heute ein altes Projekt wieder in Angriff genommen und dazu 2 sehr passende Codeschnipsel gefunden.

Ich habe ein Form erstellt das einen Fullscreen ausfüllt, im Hauptform kann man einen Ordner auswählen der Bilder beinhaltet, diese werden in ein Memo gelesen, nun Wird über einen Timer der auf dem Fullscreen Form liegt das Memo ausgelesen und immer beim Aufruf das nächste Bild in ein bmp umgewandelt und dann in über ein Tempbild im Programmverzeichnis geschrieben.

Nun möchte ich gerne das diese Bilder Ein und Aus Faden, dazu habe ich wie gesagt einen Codeschnipsel gefunden, jedoch Hab ich wohl einen Fehler in der Anwendung, die Bilder Faden total schnell rein und aber total langsam raus so überlappen sich die Bilder und es kommt ein totaler Käse bei raus.

Hat jemand ne Idee wo ich was falsch gemacht habe?

Wäre sehr dankbar wenn mir jemand helfen könnte.

LG

-SM

Hier der Code der Fullscreen Form:
Delphi-Quellcode:
unit testform;

interface

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

type
  TForm3 = class(TForm)
    Image1: TImage;
    Button2: TButton;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

uses
  main;

var
  PicCount: Integer;

{$R *.dfm}


//JPGs in Bitmaps umwandeln
procedure JpegToBmp(const Filename: String);
var
 jpeg: TJPEGImage;
 bmp: TBitmap;
begin
 jpeg:=TJPEGImage.Create;
 try
   jpeg.LoadFromFile(Filename);
   bmp:=TBitmap.Create;
   try
     bmp.Assign(jpeg);
     
     bmp.SaveToFile(ExtractFilePath(Application.ExeName)+'TempImage.bmp');
   finally
     bmp.free;
   end;
 finally
   jpeg.free;
 end;
end;


//JpegToBmp(D:\Eigene Dateien\Eigene Bilder\zunge.jpg);



type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;

procedure FadeIn(ImageFileName: TFileName);
var
  left, top: integer;
  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(ImageFileName);
    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;

        left := (Screen.WorkAreaWidth div 2) - (Bitmap.Width div 2);
        top := (Screen.WorkAreaHeight div 2) - (Bitmap.Height div 2);

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

/////////////////////////////////////////////////
//                  Fade Out                  //
/////////////////////////////////////////////////


procedure FadeOut(ImageFileName: TFileName);
var
  left, top: integer;
  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(ImageFileName);
    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
 
          left := (Screen.WorkAreaWidth div 2) - (Bitmap.Width div 2);
          top := (Screen.WorkAreaHeight div 2) - (Bitmap.Height div 2);


            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 8;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 8; // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 8;
          end;
        end;
        Form3.Canvas.Draw(left, top, Bitmap);  // neues Bild ausgeben / Output new image //
        InvalidateRect(Form3.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        RedrawWindow(Form3.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;


procedure TForm3.Button2Click(Sender: TObject);
begin
  Form3.Timer1.Enabled := False;
  form3.Close;
end;


procedure TForm3.FormCreate(Sender: TObject);
begin
PicCount := 0;
  //Fullscreen erstellen
  self.Width := Screen.Width;
  self.Height := Screen.Height;

  //Bild zentrieren
  Image1.Left:= (Screen.Width - Image1.Width) div 2;
  FadeIn(ExtractFilePath(Application.ExeName)+'TempImage.bmp');
end;

procedure TForm3.Timer1Timer(Sender: TObject);
begin
  if PicCount >= Form1.Memo1.Lines.Count-1 then
    PicCount := 0
  else
    Inc(PicCount);
    sleep(1000);
    Fadeout(ExtractFilePath(Application.ExeName)+'TempImage.bmp');
    sleep(1000);
    JpegToBmp(Form1.Edit1.Text + Form1.Memo1.Lines[PicCount]);
    sleep(1000);
    FadeIn(ExtractFilePath(Application.ExeName)+'TempImage.bmp');
end;

end.

Alien426 14. Sep 2007 17:00

Re: Bitmap Fade in and out Problem
 
Die Unterschiede in den Prozeduren sind die Zeilen zur Berechnung von "left" und "top"! Bei FadeOut werden die Werte in jedem Schleifendurchgang berechnet.

sexmagic 14. Sep 2007 17:10

Re: Bitmap Fade in and out Problem
 
Ich danke dir sehr!

Manchmal sieht man einfach nix mehr wenn man zu lange davor sitzt!


Habs berichtigt und nun funktionierts.

Danke nochmal Alien. ;)

shmia 17. Sep 2007 08:53

Re: Bitmap Fade in and out Problem
 
Deine Funktionen sind etwas zu speziell und daher ungeeignet um sie so einfach in ein beliebiges Projekt einzubinden.
Mein Vorschlag:
du brauchst eine Funktion, die 2 gleichgrosse Bitmaps entgegennimmt und über den Parameter "blend",
auf ein 3. Ausgabebitmap kopiert.
Delphi-Quellcode:
procedure BlendBitmap(BitmapA, BitmapB:TBitmap; bitmapOut:TBitmap; blend:double=0.5);
Bei Blend = 0.0 wird nur BitmapA -> bitmapOut kopiert.
Bei Blend = 1.0 wird nur Bitmapb -> bitmapOut kopiert.

In deinem Fall wird ja von einem schwarzen Bitmap auf das Bitmap eingeblendet (Fade In).
Umgekehrt wäre es ein Fade Out.
Mit der BlendBitmap Prozedure kannst du diese Effekte ebenfalls erreichen, weil du zwei
völlig beliebige Bilder (eines davon kann auch komplett schwarz sein) überblenden kannst.
Weitere Vorteil: mit BlendBitmap kannst du die Anzahl der Abstufungen völlig frei selber wählen.
In deinen Funktionen sind es 32 Stufen.
Ausserdem ist in FadeOut ein Fehler:
Delphi-Quellcode:
for step := 32 downto 0 do
    ...
    Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 8;     // richtig wäre shr 5;
    Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 8; // weil 2 ^ 5 = 32
    Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 8;

sexmagic 17. Sep 2007 15:50

Re: Bitmap Fade in and out Problem
 
Hallo!

Die Idee verstehe ich, das Problem ist das alle Bilder verschieden gross sind und daher würde das dann ja nicht funktionieren oder?

Es funktioniert nun aber ganz gut wie ich finde, das mit der 8 hab ich geändert weil ich mal testen wie es sich auswirkt, ist bereits wieder auf 5 zurückgestellt.


Danke trotzdem für deinen Vorschlag.

;)

shmia 17. Sep 2007 17:53

Re: Bitmap Fade in and out Problem
 
Zitat:

Zitat von sexmagic
Die Idee verstehe ich, das Problem ist das alle Bilder verschieden gross sind und daher würde das dann ja nicht funktionieren oder?

Verschieden grosse Bitmaps lassen sich so nicht überblenden, aber Farbefläche->Bild oder Bild->Farbfläche wäre ja trotzdem möglich.
Und ein Bitmap mit einer Farbe in der gleichen Grösse wie das Bildbitmap lässt sich ja relativ einfach zur Laufzeit erzeugen.
Ausserdem kann man Bilder in beliebiger Grösse auch zur Laufzeit erzeugen, so wie das z.B. Windows
mit dem Desktop- Hintergrund macht (Stichwort kacheln).
Zitat:

Zitat von sexmagic
Danke trotzdem für deinen Vorschlag.

Nun ja, man kann entweder profesionell programmieren oder auf niedrigem Niveau. Deine oben gezeigten Funktionen haben das niedrige Niveau:
Fade-In und Fade-Out ist doch genau das Gleiche nur in unterschiedlicher Richtung.
Also darf es doch nur eine Funktion sein.
Falls du also etwas Lernen möchtest, dann wirf deine grauen Zellen an und versuche die procedure BlendBitmap zu schreiben.

sexmagic 17. Sep 2007 19:52

Re: Bitmap Fade in and out Problem
 
Zitat:

Zitat von shmia
Falls du also etwas Lernen möchtest, dann wirf deine grauen Zellen an und versuche die procedure BlendBitmap zu schreiben.

Woher weisst du das meine Zellen schon so grau sind? :P

Ich weiss das das vielleicht nicht die Pro Variante ist, aber für mich ist das schon die Experten Variante die ich da drin habe, ich bin schon froh das ich das so einigermassen mit Hilfe der anderen zum laufen gebracht habe.
Und glaub mir ich würde nichts lieber tun als stundenlang nur aus Spass etwas zu Programmieren, leider habe ich nicht die nötige Zeit dafür. Was nicht heisst das ich es nicht gerne machen würde.
Ich danke dir trotzdem für deinen kleinen Tritt in den Arsch (Ich habs kapiert!)

;)


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:50 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz