![]() |
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. |
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.
|
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. ;) |
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:
Bei Blend = 0.0 wird nur BitmapA -> bitmapOut kopiert.
procedure BlendBitmap(BitmapA, BitmapB:TBitmap; bitmapOut:TBitmap; blend:double=0.5);
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; |
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. ;) |
Re: Bitmap Fade in and out Problem
Zitat:
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:
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. |
Re: Bitmap Fade in and out Problem
Zitat:
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 23:46 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz