Fullscreen SlideShow Bilder animieren

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