AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Bitmap Fade in and out Problem

Ein Thema von sexmagic · begonnen am 14. Sep 2007 · letzter Beitrag vom 17. Sep 2007
Antwort Antwort
sexmagic

Registriert seit: 16. Sep 2006
56 Beiträge
 
Delphi 2006 Professional
 
#1

Bitmap Fade in and out Problem

  Alt 14. Sep 2007, 15:34
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.
  Mit Zitat antworten Zitat
Benutzerbild von Alien426
Alien426

Registriert seit: 21. Dez 2005
146 Beiträge
 
Turbo Delphi für Win32
 
#2

Re: Bitmap Fade in and out Problem

  Alt 14. Sep 2007, 17:00
Die Unterschiede in den Prozeduren sind die Zeilen zur Berechnung von "left" und "top"! Bei FadeOut werden die Werte in jedem Schleifendurchgang berechnet.
  Mit Zitat antworten Zitat
sexmagic

Registriert seit: 16. Sep 2006
56 Beiträge
 
Delphi 2006 Professional
 
#3

Re: Bitmap Fade in and out Problem

  Alt 14. Sep 2007, 17:10
Ich danke dir sehr!

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


Habs berichtigt und nun funktionierts.

Danke nochmal Alien.
  Mit Zitat antworten Zitat
shmia

Registriert seit: 2. Mär 2004
5.508 Beiträge
 
Delphi 5 Professional
 
#4

Re: Bitmap Fade in and out Problem

  Alt 17. Sep 2007, 08:53
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.
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;
Andreas
  Mit Zitat antworten Zitat
sexmagic

Registriert seit: 16. Sep 2006
56 Beiträge
 
Delphi 2006 Professional
 
#5

Re: Bitmap Fade in and out Problem

  Alt 17. Sep 2007, 15:50
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.

  Mit Zitat antworten Zitat
shmia

Registriert seit: 2. Mär 2004
5.508 Beiträge
 
Delphi 5 Professional
 
#6

Re: Bitmap Fade in and out Problem

  Alt 17. Sep 2007, 17:53
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 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.
Andreas
  Mit Zitat antworten Zitat
sexmagic

Registriert seit: 16. Sep 2006
56 Beiträge
 
Delphi 2006 Professional
 
#7

Re: Bitmap Fade in and out Problem

  Alt 17. Sep 2007, 19:52
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?

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!)

  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:01 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