DBR Delphi-Ecke

// Wenn man sich animierte Gifs anzeigen lassen will ohne eine
// GIF-Komponente zu verwenden, kann man den Internetexplorer(ab 4.0)
// dazu missbrauchen. Diese Art der Anzeige eignet sich z.B.
// für Vorschauen, wobei man noch eine Begrenzung der Breite und
// Höhe sowie eine Skalierung großer Bilder einfügen sollte.

// Getestet mit D4 unter WinME

uses OleCtnrs; 
 
OleContainer1: TOleContainer; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  OleContainer1 := TOleContainer.create(self); 
  OleContainer1.parent := self; 
  OleContainer1.left := 10; 
  OleContainer1.top := 10; 
  OleContainer1.visible := false; 
end; 
 
procedure abschalten; 
begin 
  with Form1 do begin 
    try 
      OleContainer1.visible := false; 
      OleContainer1.close; 
      OleContainer1.destroyobject; 
    except 
    end; 
  end; 
end; 
 
function Zeige_IE_GIF(bild: string): string; 
var 
  tf: TFilestream; 
  w, h: word; 
  a: array[0..2] of char; 
  f: string; 
begin 
  with Form1 do begin 
    if not fileexists(bild) then begin 
      result := 'Datei nicht gefunden'; 
      exit; 
    end; 
    try 
      f := inttohex(colortorgb(color), 6); // Kompromiss 
      tf := tfilestream.create(bild, fmopenread); 
      tf.readbuffer(a, 3); 
      tf.position := 6; 
      tf.readbuffer(w, sizeof(Word)); 
      tf.readbuffer(h, sizeof(Word)); 
      tf.free; 
      if a <> 'GIF' then begin 
        result := 'Sorry, kein GIF'; 
        exit; 
      end; 
      OleContainer1.CreateObject('Shell.Explorer', false); 
      OleContainer1.clientwidth := w; 
      OleContainer1.clientheight := h; 
      OleContainer1.visible := true; 
      OleContainer1.oleobject.navigate('about:<html>' + 
        '<body bgcolor="#' + f + '" topmargin="0" leftmargin="0" scroll="no">' + 
        '<img src="' + bild + '"></img></body></html>'); 
      OleContainer1.visible := true; 
      OleContainer1.DoVerb(ovshow); 
      result := 'OK'; 
    except 
      result := 'Es ist ein Fehler aufgetreten'; 
      abschalten; 
    end; 
  end; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  abschalten; 
end; 
 
 
// GIF anzeigen 
 
procedure TForm1.Button4Click(Sender: TObject); 
var s: string; 
begin 
  s := Zeige_IE_GIF('d:\gifs\dice.gif'); 
  if s <> 'OK' then showmessage(s); 
end; 
 
// Anzeige ausschalten 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  abschalten; 
end;