Fullscreen SlideShow Bilder animieren

[sexmagic]

Hallo Jungs,

ich stehe wiedermal vor einem Probelm.


Ich möchte für einen Freund eine Slideshow erstellen die er über einen Beamer auf einem Plexiglas vorstellt.
Die Bilder werden aus einem Ordner ausgelesen und in einem Memo eingelesen.

Beim starten der Show wird ein neues Form geladen und dies liest einfach die Einträge aus dem Memo aus und Zeigt dann die Bilder an.

Mein Problem ist nun das ich zwischen den Bildern gerne animierte übergänge hätte, Fade In, Fade Out, Einfahren von links, rechts oder oben,...

Ich verwende nur Jpgs, wenn es möglich ist das ohne Fremdkomponenten zu machen wärs mir am liebsten aber muss nicht sein, gegen eine einfach zu verwendende Komponenten hab ich auch nix. bin aber noch blutiger Anfänger.

Hier mal der Code aus der Fullscreen Unit:

Delphi-Quellcode:

procedure TForm2.Button1Click(Sender: TObject);
begin

if PicCount >= Form1.Memo1.Lines.Count-1 then
    PicCount := 0
  else
    Inc(PicCount);
    Image1.Picture.LoadFromFile(Form1.Edit1.Text + Form1.Memo1.Lines[PicCount]);

end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Form2.Close;
end;

procedure TForm2.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;
end;



procedure TForm2.FormShow(Sender: TObject);
var
  PicWidth: integer;
  PicHeight: Integer;
begin
if (Form1.Memo1.Lines[0]) = '' then
  ShowMessage('Kein Bild vorhanden.')
else
    begin
      PicWidth := Image1.Picture.Bitmap.Width;
      PicHeight := Image1.Picture.Bitmap.Height;
      Image1.Picture.LoadFromFile(Form1.Edit1.Text + Form1.Memo1.Lines[PicCount]);
    end;
end;

Vielleicht kann mir ja einer ein paar Tips geben, is nicht dringend aber würde mich freuen.

Die Suche ergab auch einiges aber kommt mir alles etwas umständlich vor, naja war auch nicht genau für solche sachen wie ich vorhabe.

Also erstmal schönen Dank im voraus!

;)

[Andreas L.]

Mit einen Timer alle paar Millisekunden das Bild nach links und unten verschieben. DoubleBuffered vom Form auf TRUE stellen!!!

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 inc(img.left);
 inc(img.top);
end;

Den optimalen Intervall für den Timer musst du durch testen selbst rausfinden.

[Neutral General]

Zitat:

Zitat von Andreas L.

Mit einen Timer alle paar Millisekunden das Bild nach links und unten verschieben. DoubleBuffered vom Form auf TRUE stellen!!!

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 inc(img.left);
 inc(img.top);
end;

Den optimalen Intervall für den Timer musst du durch testen selbst rausfinden.

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 img.Left := img.Left + 1;
 img.Top := img.Top + 1;
end;

Inc funktioniert da nicht ;)

Gruß
Neutral General

[Namenloser]

Fürs überblenden hab ich mal eine Funktion geschrieben:

Delphi-Quellcode:

type
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
  PRGB32Array = ^TRGB32Array;

{...}

procedure BlendBitmap(X,Y: integer; const Dest,Bitmap: TBitmap; alpha: integer);
var xx,yy : integer;
    DestLine, BitLine: pRGB32Array;
begin
  bitmap.PixelFormat:=pf32Bit;
  dest.PixelFormat:=pf32Bit;

  for yy := 0 to Bitmap.Height - 1 do
    begin
      BitLine := Bitmap.ScanLine[yy];
      DestLine := Dest.Scanline[yy+y];
      for xx := 0 to Bitmap.Width - 1 do
      begin
        DestLine[xx+x].r:=round((BitLine[xx].r/100*(100-Alpha))+
          (DestLine[xx+x].r/100*Alpha));
        DestLine[xx+x].g:=round((BitLine[xx].g/100*(100-Alpha))+
          (DestLine[xx+x].g/100*Alpha));
        DestLine[xx+x].b:=round((BitLine[xx].b100*(100-Alpha))+
          (DestLine[xx+x].b/100*Alpha));
      end;
    end;
end;

X und y geben an, an welche stelle du das Bild (Bitmap) auf das Zielbitmap (dest) zeichnen möchtest. alpha ist der transparenzwert (zwischen 0 und 100)

[sexmagic]

Hallo Jungs, vielen Dank für die Tips, leider habe ich erst heute wieder Zeit mir das anzuschauen darum erst jetzt eine Reaktion.

Als erstes würde ich gerne das Überblenden einbauen da das eine Standartfunnktion werden soll und dann zb jedes 4 Bild verschieben oder so.

Leider komm ich mit dieser Funktion noch nicht wirklich klar NamenLozer.
Kannst du mir das mal kurz erklären, das "TRGB32" in der Type Deklaration wird schon mal gleich unterstrichen von Delphi wegen undeklarierter Bezeichner.

Muss ich da ne Unit einbinden oder sowas.

Dann frage ich mich noch wie ich das nun wirklich anwende.

Das Bild soll ausfaden und das nächste dann wieder ein das ein weicher Übergang entsteht.

Delphi-Quellcode:

procedure BlendBitmap(X,Y: integer; const Dest,Bitmap: TBitmap; alpha: integer);

-Also ich müsste nun um ein Bild auszufaden erstmal die Koordinaten rausfinden weil die Bilder sind ja einfach durch den Objektmanager Zentriert worden.

-Was ist aber Dest, das is mir am wenigsten klar bei den anderen weis ich zumindest was gemeint ist.

-Bitmap: is das Bild das gefadet wird.

-alpha: Geb ich 100 an wirds komplett ausgeblendet, geb ich 50 an wirds nur zur hälfte ausgefadet? Richtig?

Wäre über ein Kurze Beispiel sehr erfreut, ich glaub seonst werde ich das nicht schaffen :/

[Namenloser]

Ja, sorry, hab ich vergessen zu sagen: TRGB32 ist ein record, der so aufgebaut ist:

Delphi-Quellcode:

trgb32 = record
r,g,b,a: byte;
end;

beispiel kommt:

Delphi-Quellcode:

var x: integer;
oldpic, newpic: TBitmap;

procedure tform1timertimer(sender: tobject);
var buffer: TBitmap;
begin
  inc(x);
  buffer := TBitmap.create;
  buffer.assign(oldpic);
  blendbitmap(0, 0, buffer, newpic);
  canvas.draw(0,0,buffer); // Zu faul für bitblt XD
  buffer.free; // edit^^ das sollte schon sein
end;

[Rudirabbit]

Hi !
@NamenLozer: Ich verstehe zwar deinen Code :???: , muß aber zugeben, daß ich nicht selbst draufgekommen wäre !

Wenn ich dein Alter, 12 ! (richtig ??) anschaue.... respekt !

MFg !

[sexmagic]

Danke für das Beispiel, hab nun lange rumprobiert aber der Code is mir irgendwie noch zu unklar.

Bei mir siehts nun so aus aber blendbitmap und canvas.draw sind undefinierte bezeichnier, welche Komponenten muss ich dazu auf das Form ziehen.
b100 wir auch nicht erkannt.

Vielleicht ist der Code für mich als totaler Anfänger doch etwas zu schwierig, wenn du noch Zeit hast und mir das mal in meinem Code so einrichtest wies aussehen soll wäre sehr fein, sonst muss ich erstmal mit dem verschieben probieren, sieht im Moment etwas Hoffnungsvoller aus :)

Jedenfalls vielen Dank das du dir die Mühe gemacht hast auch noch ein Beispiel zu schrieben.

Danke

So siehts nun bei mir aus:

Delphi-Quellcode:

unit fullscreen;

interface

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

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    
  private
    { Private-Deklarationen }
  public
  
    { Public-Deklarationen }
  end;

  trgb32 = record r,g,b,a: byte; end;

var
  Form2: TForm2;

implementation


uses
  main;

var
  PicCount: Integer;
  x: integer;
  oldpic, newpic: TBitmap;

type
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
  PRGB32Array = ^TRGB32Array;


{$R *.dfm}


procedure tform1timertimer(sender: tobject);
var buffer: TBitmap;
begin
  inc(x);
  buffer := TBitmap.create;
  buffer.assign(oldpic);
  blendbitmap(0, 0, buffer, newpic);
  canvas.draw(0,0,buffer); // Zu faul für bitblt XD
  buffer.free; // edit^^ das sollte schon sein
end;


procedure TForm2.Button1Click(Sender: TObject);
begin

if PicCount >= Form1.Memo1.Lines.Count-1 then
    PicCount := 0
  else
    Inc(PicCount);
    Image1.Picture.LoadFromFile(Form1.Edit1.Text + Form1.Memo1.Lines[PicCount]);

end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Form2.Close;
end;

procedure TForm2.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;
end;



procedure TForm2.FormShow(Sender: TObject);
var
  PicWidth: integer;
  PicHeight: Integer;
begin
if (Form1.Memo1.Lines[0]) = '' then
  ShowMessage('Kein Bild vorhanden.')
else
    begin
      PicWidth := Image1.Picture.Bitmap.Width;
      PicHeight := Image1.Picture.Bitmap.Height;
      Image1.Picture.LoadFromFile(Form1.Edit1.Text + Form1.Memo1.Lines[PicCount]);
    end;
end;



procedure BlendBitmap(X,Y: integer; const Dest,Bitmap: TBitmap; alpha: integer);
var xx,yy : integer;
    DestLine, BitLine: pRGB32Array;
begin
  bitmap.PixelFormat:=pf32Bit;
  dest.PixelFormat:=pf32Bit;

  for yy := 0 to Bitmap.Height - 1 do
    begin
      BitLine := Bitmap.ScanLine[yy];
      DestLine := Dest.Scanline[yy+y];
      for xx := 0 to Bitmap.Width - 1 do
      begin
        DestLine[xx+x].r:=round((BitLine[xx].r/100*(100-Alpha))+
          (DestLine[xx+x].r/100*Alpha));
        DestLine[xx+x].g:=round((BitLine[xx].g/100*(100-Alpha))+
          (DestLine[xx+x].g/100*Alpha));
        DestLine[xx+x].b:=round((BitLine[xx].b100*(100-Alpha))+
          (DestLine[xx+x].b/100*Alpha));
      end;
    end;
end;

end.

[Namenloser]

Delphi-Quellcode:

unit fullscreen;

interface

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

type
  trgb32 = record
    r,g,b,a: byte;
  end;

  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
  PRGB32Array = ^TRGB32Array;

  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    timer1: TTimer; //  ENTSPRECHENDE TIMER-KOMPONENTE AUF FORMULAR ZIEHEN UND
                    //  IM ONTIME-EVENT "TIMER1TIME" AUSWÄHLEN!
                    //  Beim Intervall so um die 50 einstellen, da musst du
                    //  ausprobieren.
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

  PicCount: Integer;
  x: integer;
  oldpic, newpic: TBitmap;

procedure BlendBitmap(X,Y: integer; const Dest,Bitmap: TBitmap; alpha: integer);

implementation

uses
  main;

{$R *.dfm}

procedure BlendBitmap(X,Y: integer; const Dest,Bitmap: TBitmap; alpha: integer);
var xx,yy : integer;
    DestLine, BitLine: pRGB32Array;
begin
  bitmap.PixelFormat:=pf32Bit;
  dest.PixelFormat:=pf32Bit;

  for yy := 0 to Bitmap.Height - 1 do
    begin
      BitLine := Bitmap.ScanLine[yy];
      DestLine := Dest.Scanline[yy+y];
      for xx := 0 to Bitmap.Width - 1 do
      begin
        DestLine[xx+x].r:=round((BitLine[xx].r/100*(100-Alpha))+
          (DestLine[xx+x].r/100*Alpha));
        DestLine[xx+x].g:=round((BitLine[xx].g/100*(100-Alpha))+
          (DestLine[xx+x].g/100*Alpha));
        DestLine[xx+x].b:=round((BitLine[xx].b/100*(100-Alpha))+
          (DestLine[xx+x].b/100*Alpha));
      end;
    end;
end;


procedure tform2.timer1timer(sender: tobject);
var buffer: TBitmap;
begin
  inc(x); // Wenn das fading auf diese weise zu langsam ist, inc(x, 2), oder
          // inc(x,3) oder inc(x,10)... ausprobiern!
  if x > 100 then
    timer1.enabled := false;
  buffer := TBitmap.create;
  buffer.assign(oldpic);
  blendbitmap(0, 0, buffer, newpic, x);
  bitblt(image1.picture.bitmap.canvas.handle, 0,0,buffer.width,buffer.height,
    buffer.canvas.handle,0,0,srccopy);
  buffer.free;
end;


procedure TForm2.Button1Click(Sender: TObject);
begin
  if PicCount >= Form1.Memo1.Lines.Count-1 then
    PicCount := 0
  else
    Inc(PicCount);
  Image1.Picture.LoadFromFile(Form1.Edit1.Text + Form1.Memo1.Lines[PicCount]);
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Form2.Close;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  PicCount := 0;

  // Bitmaps erzeugen
  oldpic := TBitmap.Create;
  newpic := tBitmap.create;

  //Fullscreen erstellen
  self.Width := Screen.Width;
  self.Height := Screen.Height;

  //Bild zentrieren
  Image1.Left:= (Screen.Width - Image1.Width) div 2;
end;


procedure TForm2.FormShow(Sender: TObject);
var
  PicWidth: integer;
  PicHeight: Integer;
begin
  if (Form1.Memo1.Lines[0]) = '' then
    ShowMessage('Kein Bild vorhanden.')
  else
  begin
    PicWidth := Image1.Picture.Bitmap.Width;
    PicHeight := Image1.Picture.Bitmap.Height;
    //   Das neue wird zum alten
    oldpic.assign(newpic);
    Image1.Picture.bitmap.assign(oldpic);
    //   Neues Bild laden
    newpic.LoadFromFile(Form1.Edit1.Text + Form1.Memo1.Lines[PicCount])
    timer1.enabled := true;  //   Überblenden starten!
  end;
end;

end.

Ungetestet!

b100 warn schreibfehler, muss heißen b/100. wie wärs mal mit code anschauen und nachdenken (und verstehn?) ?


Naja, ich hoffe jedenfalls, es geht!

[sexmagic]

Danke NamenLozer

es funktioniert leider nicht, beim öffnen des Fullscreenfenster kommt leider ein Fehler, der aus dem OnFormShow kommt.
"Bitmap ungültig", da stimmt was nicht mit den Inhalten von newpic und oldpic.
Wenn ich manuell ein Bild weiterschalte dann funktioniert die Show wieder aber es ist kein Blendeffekt zu erkenne, ich habe den Zeitintervall verändert und auch den maximalen Aplha aber es schaut so aus als wenn das garnicht zum Einsatz kommt.
:(

Ich habe leider keinen blassen Schimmer woran das liegt ich blicke nicht durch den Code, ich denke nicht das ich das selbst hinkriege.

Ich werde besser mal mit einfacheren Sachen beginnen, dachte nicht das so eine einfache Überblendung so schwer zu erstellen ist. :/

Jedenfalls danke ich dir für deine Mühen.

[waseo]

Wenn Du es einfacher haben willst, probiere mal die folgende Komponente auf http://www.torry.net: TPicShow. Die bietet 171 Übergangseffekte und ist außerdem noch Freeware.

[sexmagic]

Die funktioniert aber nicht mit D2006?

Hab ich schon versucht einzubinden aber hat nicht geklappt, im FOrum wird auch davon gesprochen das das mit D2006 noch nicht kompatibel ist.

Das is genau das was ich suche, hoffen wir das das bald ein Update erfahren darf.

Trotzdem danke für den Hinweis.

;)

[Rudirabbit]

Hi !

@NamenLozer:
Hab's mal getestet.

Delphi-Quellcode:

  bitblt(image1.picture.bitmap.canvas.handle, 0,0,buffer.width,buffer.height,buffer.canvas.handle,0,0,srccopy);

Das Kopieren des puffers via bitblt in das Image Object funzt nicht, auch ein Syntaxfehler ist nicht dabei :gruebel: warum ??
Ein einfaches :

Delphi-Quellcode:

 image1.Picture.Bitmap:=buffer;

führt zum Erfolg.

MFG !