procedure TForm1.FormCreate(Sender: TObject);  
begin  
  doublebuffered := true;  
  bmp81.clear;  
  bmp81.Bitmap0.loadfromfile('C:\Frau.bmp');  
  bmp81.Bitmap1.loadfromfile('C:\Sonne.bmp');  
  bmp81.Bitmap2.loadfromfile('C:\Frosch.bmp');  
  bmp81.Reveal := '012';  
end;  
  
procedure TForm1.Button4Click(Sender: TObject);  
var x, y: integer;  
begin  
  for y := 2 downto 1 do begin  
    bmp81.level := y;  
    bmp81.Alpha := 0;  
    for x := 0 to 9 do begin  
      bmp81.Alpha := bmp81.Alpha + 25;  
      bmp81.refresh;  
      sleep(60);  
    end;  
    sleep(750);  
  end;  
  sleep(250);  
  for y := 2 downto 0 do begin  
    bmp81.level := y;  
    bmp81.Alpha := 0;  
  end;  
end; 

//---------------- Beispiel 2 ------------------------------------------
// Schwarz als undurchsitige Farbe

 

procedure TForm1.FormCreate(Sender: TObject);  
begin  
  doublebuffered := true;  
  bmp81.clear;  
  bmp81.Bitmap0.loadfromfile('C:\det.bmp');  
  bmp81.Reveal := '01234567';  
  bmp81.Color := clLime;  
  bmp81.Opaque := true;  
  bmp81.OpaqueColor := clBlack;  
end;  
  
procedure TForm1.TrackBar1Change(Sender: TObject);  
begin  
  bmp81.Level := 0;  
  bmp81.alpha := trackbar1.position;  
end; 

//---------------- Beispiel 3 ------------------------------------------
// Durchscheinende Bilder

procedure TForm1.FormCreate(Sender: TObject);  
begin  
  doublebuffered := true;  
  bmp81.clear;  
  bmp81.Bitmap0.loadfromfile('C:\test.bmp');  
  bmp81.Bitmap1.loadfromfile('C:\frau.bmp');  
  bmp81.Reveal := '10';  
end;  
  
procedure TForm1.Button4Click(Sender: TObject);  
begin  
  bmp81.Bitmap0.transparent := true;  
  bmp81.Level := 0;  
  bmp81.Alpha := 127;  
  bmp81.SaveAsBitmap('c:\testbmp8.bmp');  
end; 

//---------------- Beispiel 4 ------------------------------------------
// Grafik (hier TIcon) laden

Step 1	Step 2	Step 3

procedure TForm1.FormCreate(Sender: TObject);  
begin  
  doublebuffered := true;  
  // Step 1  
  bmp81.clear;  
  bmp81.Color := clYellow;  
  bmp81.Reveal := '01';  
  bmp81.AutoSize := 0;  
  bmp81.Bitmap0.loadfromfile('c:\frau.bmp');  
  // Step 2  
  bmp81.Level := 1;  
  bmp81.Picture.Loadfromfile('c:\pss.ico');  
  bmp81.OffsetX := -(Bmp81.width - bmp81.Bitmap1.width) div 2;  
  bmp81.OffsetY := (Bmp81.height - bmp81.Bitmap1.height) div 2;  
  // Step 3  
  bmp81.Bitmap1.Transparent := true;  
end; 

//---------------- Beispiel 5 ------------------------------------------
// Ebenen verschieben

Step 1	Step 2	Step 3

procedure TForm1.Button5Click(Sender: TObject);  
begin  
  doublebuffered := true;  
  // Step 1  
  with bmp81 do begin  
    clearS;  
    color := $99FFFF;  
    Reveal := '012';  
    Bitmap0.loadfromfile('c:\frau8.bmp');  
    OffsetX := -(width - Bitmap0.width) div 2;  
    OffsetY := -(height - Bitmap0.height) div 2;  
    Level := 1;  
    Bitmap1.loadfromfile('c:\sonne8.bmp');  
    OffsetX := (width - Bitmap1.width) div 2;  
    OffsetY := (height - Bitmap1.height) div 2;  
    Bitmap2.loadfromfile('c:\frosch8.bmp');  
  end;  
  application.processmessages;  
  sleep(2000);  
  // Step 2  
  bmp81.Reveal := '021';  
  application.processmessages;  
  sleep(2000);  
  // Step 3  
  bmp81.Reveal := '120';  
end; 

// ================== Erläuterung der Eigenschaften ===================

Bitmap0...Bitmap7: TBitmap
Acht zur Verfügung stehende Bitmaps. Sie sollten möglichts keine der
Bitmaps außerhalb der Komponente freigeben. Um ein Einzelbild zur Laufzeit
zu löschen ist nur "bmp81.bitmapX := nil" erlaubt (wobei X für 0 bis 7 steht).

Color: TColor
Bestimmt die Hintergrundfarbe. Ist nur zu bemerken wenn die Bilder
transparent oder kleiner als die Komponente sind.

Transparent: Boolean
Hintergund anzeigen/ausblenden. Ist nur zu bemerken wenn die Bilder
transparent oder kleiner als die Komponente sind.

Reveal: string
Bestimmt welche Bitmaps angezeigt bzw. ausgeblendet werden und in welcher
Reihenfolge die Bitmaps übereinanderliegen. Bei beispielsweise '012'
werden nur die ersten 3 Bilder angezeigt und Bitmap2 ist das oberste.
Bei '7531' werden nur die ungeraden Bitmaps angezeigt, Bitmap7 liegt unten
und Bitmap1 oben. Doppelte Ziffern imm String verlangsamen die Anzeige.
Zur Entwicklerzeit wird beim Laden eines Bildes "Reveal" automatisch angepasst.
Zur Laufzeit müssen Sie das vom Programm her initiieren, damit sichergestellt
ist, dass man auch ein Bild laden kann, ohne dass es gleich angezeigt wird.

Level: Byte
Bestimmt, welche Ebene die aktuelle ist. "Alpha", "Opaque", "OpaqueColor",
"OffsetX" und "OffsetY" wirken immer nur auf der zur Entwicklerzeit zuletzt
eingestellten Ebene. Wenn zur Laufzeit die Ebene gewechselt wird, müssen
diese Werte ebenfalls neu belegt werden! Man könnte aber generell so etwas tun:
var 
  farbe: array[0..7] of TColor = (clRed, clBlack,clYellow, clFuchsia, 
  clGreen, clLime, clPurple, $88FF); 

procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: integer; 
begin 
  doublebuffered := true; 
  for x := 0 to 7 do begin 
    bmp81.level := x; 
    bmp81.Opaque := true; 
    bmp81.OpaqueColor := farbe[x]; 
  end; 
end;
Sinngemäß gilt das Gleiche für Alpha, OffsetX und OffsetY.

Opaque: Boolean
Bestimmt, ob eine Farbe undurchsichtig bleibt.
Eigentlich für die Laufzeit gedacht. Kann aber zur Entwicklerzeit
zum Testen benutzt werden.

OpaqueColor: TColor
Bestimmt, welche Farbe undurchsichtig bleibt bei "Opaque = True".
Eigentlich für die Laufzeit gedacht. Kann aber zur Entwicklerzeit
zum Testen benutzt werden.

Alpha: Byte
Bestimmt die durchsichtigkeit des aktuellen Bildes von 0 ... 255
(undurchsichtig ... komplett durchsichtig).
Eigentlich für die Laufzeit gedacht. Kann aber zur Entwicklerzeit
zum Testen benutzt werden.

AutoSize: Byte
Hiermit kann man die Größe der Komponente auf die Größe einer der
Bitmaps (0..7) setzen. Hat Autosize den Wert Acht, wird es abgeschaltet.
Ist der Wert größer als Acht, erhält die Komponente die Standardgröße
150 x 150. Bestimmt man eine Bitmap welche kein Bild enthält, wird die
Eingabe (bis zum Laden eines Bildes in die entsprechende Ebene) ignoriert.

OffsetX: integer
Verschiebt das Bild der aktuellen Ebene (siehe Level) waagerecht.
Eigentlich für die Laufzeit gedacht. Kann aber zur Entwicklerzeit
zum Testen benutzt werden.

OffsetY: integer
Verschiebt das Bild der aktuellen Ebene (siehe Level) senkrecht.
Eigentlich für die Laufzeit gedacht. Kann aber zur Entwicklerzeit
zum Testen benutzt werden.

Picture: TPicture
Leerer Container zur Aufnahme von Grafiken, die nicht vom Typ TBitmap sind.
Je nach dem Wert von "Level" werden die Bilder einem der Bitmaps zugewiesen.

Clear (nur zur Laufzeit)
Löscht die Bilder und resetet die Komponente ohne die Größe zu verändern.

ClearS (nur zur Laufzeit)
Löscht die Bilder, resetet die Komponente und setzt die Größe auf 150 x 150.

SaveToStream(const FileName: string) (nur zur Laufzeit)
Speichert Bilder und Einstellungen in einen Stream. Hier könnte man
noch eine Komprimierung einbauen. Das überlasse ich aber jedem selbst.

LoadFromStream(const FileName: string) (nur zur Laufzeit)
Lädt Bilder und Einstellungen aus einem Stream.

SaveToFile(const FileName: string) (nur zur Laufzeit)
Speichert Bilder und Einstellungen in eine Datei.

LoadFromFile(const FileName: string) (nur zur Laufzeit)
Lädt Bilder und Einstellungen aus einer Datei.

SaveAsBitmap(const FileName: string) (nur zur Laufzeit)
Speichert die Anzeige, so wie man sie sieht, in eine Bitmap.

Bitmaps: Byte (nur zur Laufzeit)
Gibt die Anzahl der geladenen (gültigen) Bilder zurück.

Hinweis:
Animierte GIF-Dateien sollten nicht unbedingt geladen werden, da es zu
Anzeigefehlern kommen kann.


//=======================================================================

unit BMP8; 
 
interface 
 
uses Windows, Classes, Controls, Graphics, SysUtils; 
 
type 
 
  TBmp8 = class(TGraphicControl) 
  private 
    FW3: integer; 
    Flag: Boolean; 
    FPic: TPicture; 
    FS: TFileStream; 
    FLevel, FAuto: Byte; 
    FHintergrund: TBitmap; 
    FReveal, FVersion: string; 
    FSolid: array[0..7] of Boolean; 
    FArray: array[0..7] of TBitmap; 
    FTransparent, Fow, Foh: Boolean; 
    FOpaque: array[0..7, 0..2] of Byte; 
    FDiff, FAlpha: array[0..7] of Byte; 
    FOffset: array[0..7, 0..1] of Integer; 
  protected 
    procedure setTransparent(b: boolean); 
    procedure setOpaque(c: TColor); 
    procedure setSolid(b: boolean); 
    procedure setReveal(s: string); 
    procedure setlevel(b: byte); 
    procedure setAlpha(b: byte); 
    function getOpaque: TColor; 
    procedure setAuto(b: byte); 
    function GetAlpha: byte; 
    procedure build8(a: byte); 
    procedure paint; override; 
    function GetBitmap0: TBitmap; 
    procedure setbitmap0(bm: TBitmap); 
    function GetBitmap1: TBitmap; 
    procedure setbitmap1(bm: TBitmap); 
    function GetBitmap2: TBitmap; 
    procedure setbitmap2(bm: TBitmap); 
    function GetBitmap3: TBitmap; 
    procedure setbitmap3(bm: TBitmap); 
    function GetBitmap4: TBitmap; 
    procedure setbitmap4(bm: TBitmap); 
    function GetBitmap5: TBitmap; 
    procedure setbitmap5(bm: TBitmap); 
    function GetBitmap6: TBitmap; 
    procedure setbitmap6(bm: TBitmap); 
    function GetBitmap7: TBitmap; 
    procedure setbitmap7(bm: TBitmap); 
    procedure BChange(Sender: TObject); 
    procedure Basis; 
    procedure notifi(txt: string); 
    procedure drauf(cnv: TCanvas); 
    function getsolid: boolean; 
    function nopic(w: byte): boolean; 
    procedure standard; 
    procedure anpassen(b: byte); 
    procedure makesize(b: byte); 
    procedure setOffx(i: integer); 
    function getOffx: integer; 
    procedure setOffy(i: integer); 
    function getOffy: integer; 
    procedure setPicture(p: Tpicture); 
    procedure makePicture(p: Tpicture); 
    procedure PChange(Sender: TObject); 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    procedure Resize; override; 
    function Bitmaps: Byte; 
    procedure SaveToStream(stream: TStream); 
    procedure LoadFromStream(stream: TStream); 
    procedure SavetoFile(const FileName: string); 
    procedure LoadFromFile(const FileName: string); 
    procedure SaveAsBitmap(const FileName: string); 
    procedure Clear; 
    procedure ClearS; 
  published 
    property Level: Byte read FLevel write setLevel; 
    property AutoSize: Byte read FAuto write setAuto; 
    property Alpha: Byte read GetAlpha write setAlpha; 
    property Reveal: string read FReveal write setReveal; 
    property OffsetX: Integer read GetOffx write setOffx; 
    property OffsetY: Integer read GetOffy write setOffy; 
    property Opaque: Boolean read getSolid write setSolid; 
    property Picture: TPicture read FPic write setpicture; 
    property Bitmap0: TBitmap read GetBitmap0 write Setbitmap0; 
    property Bitmap1: TBitmap read GetBitmap1 write Setbitmap1; 
    property Bitmap2: TBitmap read GetBitmap2 write Setbitmap2; 
    property Bitmap3: TBitmap read GetBitmap3 write Setbitmap3; 
    property Bitmap4: TBitmap read GetBitmap4 write Setbitmap4; 
    property Bitmap5: TBitmap read GetBitmap5 write Setbitmap5; 
    property Bitmap6: TBitmap read GetBitmap6 write Setbitmap6; 
    property Bitmap7: TBitmap read GetBitmap7 write Setbitmap7; 
    property OpaqueColor: TColor read getOpaque write setOpaque; 
    property Transparent: Boolean read FTransparent write setTransparent; 
    property ParentShowhint; 
    property Parentcolor; 
    property Enabled; 
    property Visible; 
    property Color; 
    property ShowHint; 
    property OnMouseup; 
    property OnMouseDown; 
    property OnMouseMove; 
    property OnDblClick; 
    property OnClick; 
  end; 
 
procedure Register; 
 
implementation 
 
procedure Register; 
begin 
  RegisterComponents('DBR', [TBmp8]); 
end; 
 
procedure TBmp8.paint; 
var 
  x: Byte; 
begin 
  FHintergrund.width := width; 
  FHintergrund.height := succ(height); 
  Fow := odd(width); 
  Foh := odd(height); 
  FW3 := width * 3; 
  with FHintergrund.canvas do begin 
    if not FTransparent then begin 
      brush.color := color; 
      fillrect(cliprect); 
    end else 
      copyrect(cliprect, canvas, canvas.cliprect); 
  end; 
  for x := 1 to length(FReveal) do 
    if FReveal[x] in ['0'..'7'] then 
      build8(strtoint(FReveal[x])); 
  drauf(Canvas); 
end; 
 
constructor TBmp8.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  FPic := TPicture.create; 
  FPic.OnChange := PChange; 
  Flag := false; 
  FVersion := '1.1'; 
  FTransparent := False; 
  FHintergrund := TBitmap.create; 
  FHintergrund.pixelformat := pf24bit; 
  standard; 
  basis; 
end; 
 
destructor TBmp8.Destroy; 
var 
  x: Byte; 
begin 
  for x := 0 to 7 do begin 
    try 
      FArray[x].free; 
      FArray[x] := nil; 
    except end; 
  end; 
  FHintergrund.free; 
  FHintergrund := nil; 
  FPic.free; 
  FPic := nil; 
  inherited Destroy; 
end; 
 
procedure TBmp8.makePicture(p: TPicture); 
begin 
  if p = nil then FArray[FLevel] := nil 
  else begin 
    with FArray[FLevel], canvas do begin 
      width := p.width; 
      height := p.height; 
      brush.color := color; 
      fillrect(cliprect); 
      draw(0, 0, p.graphic); 
    end; 
  end; 
end; 
 
procedure TBmp8.setPicture(p: TPicture); 
var 
  s: string; 
begin 
  s := inttostr(FLevel); 
  makepicture(p); 
  if (pos(s, FReveal) = 0) and (csDesigning in componentstate) 
    then FReveal := FReveal + s; 
end; 
 
procedure TBmp8.drauf(cnv: TCanvas); 
begin 
  cnv.draw(0, 0, FHintergrund); 
end; 
 
procedure TBmp8.basis; 
var 
  x, y: byte; 
begin 
  color := clwhite; 
  for x := 0 to 7 do begin 
    FArray[x] := TBitmap.create; 
    FArray[x].OnChange := BChange; 
    FAlpha[x] := 0; 
    FDiff[x] := 255; 
    FOpaque[x, 0] := 0; 
    FOpaque[x, 1] := 0; 
    FOpaque[x, 2] := 0; 
    FSolid[x] := false; 
    for y := 0 to 1 do 
      FOffset[x, y] := 0; 
  end; 
  FAuto := 8; 
  FLevel := 0; 
  FReveal := ''; 
end; 
 
function TBmp8.GetBitmap0: TBitmap; 
begin 
  result := FArray[0]; 
end; 
 
procedure TBmp8.setbitmap0(bm: TBitmap); 
begin 
  FArray[0].assign(bm); 
  if pos('0', FReveal) = 0 
    then FReveal := FReveal + '0'; 
  invalidate; 
end; 
 
function TBmp8.GetBitmap1: TBitmap; 
begin 
  result := FArray[1]; 
end; 
 
procedure TBmp8.setbitmap1(bm: TBitmap); 
begin 
  FArray[1].assign(bm); 
  if (pos('1', FReveal) = 0) and (csDesigning in componentstate) 
    then FReveal := FReveal + '1'; 
  invalidate; 
end; 
 
function TBmp8.GetBitmap2: TBitmap; 
begin 
  result := FArray[2]; 
end; 
 
procedure TBmp8.setbitmap2(bm: TBitmap); 
begin 
  FArray[2].assign(bm); 
  if (pos('2', FReveal) = 0) and (csDesigning in componentstate) 
    then FReveal := FReveal + '2'; 
  invalidate; 
end; 
 
function TBmp8.GetBitmap3: TBitmap; 
begin 
  result := FArray[3]; 
end; 
 
procedure TBmp8.setbitmap3(bm: TBitmap); 
begin 
  FArray[3].assign(bm); 
  if (pos('3', FReveal) = 0) and (csDesigning in componentstate) 
    then FReveal := FReveal + '3'; 
  invalidate; 
end; 
 
function TBmp8.GetBitmap4: TBitmap; 
begin 
  result := FArray[4]; 
end; 
 
procedure TBmp8.setbitmap4(bm: TBitmap); 
begin 
  FArray[4].assign(bm); 
  if (pos('4', FReveal) = 0) and (csDesigning in componentstate) 
    then FReveal := FReveal + '4'; 
  invalidate; 
end; 
 
function TBmp8.GetBitmap5: TBitmap; 
begin 
  result := FArray[5]; 
end; 
 
procedure TBmp8.setbitmap5(bm: TBitmap); 
begin 
  FArray[5].assign(bm); 
  if (pos('5', FReveal) = 0) and (csDesigning in componentstate) 
    then FReveal := FReveal + '5'; 
  invalidate; 
end; 
 
function TBmp8.GetBitmap6: TBitmap; 
begin 
  result := FArray[6]; 
end; 
 
procedure TBmp8.setbitmap6(bm: TBitmap); 
begin 
  FArray[6].assign(bm); 
  if (pos('6', FReveal) = 0) and (csDesigning in componentstate) 
    then FReveal := FReveal + '6'; 
  invalidate; 
end; 
 
function TBmp8.GetBitmap7: TBitmap; 
begin 
  result := FArray[7]; 
end; 
 
procedure TBmp8.setbitmap7(bm: TBitmap); 
begin 
  FArray[7].assign(bm); 
  if (pos('7', FReveal) = 0) and (csDesigning in componentstate) 
    then FReveal := FReveal + '7'; 
  invalidate; 
end; 
 
procedure TBmp8.setTransparent(b: boolean); 
begin 
  if b = FTransparent then exit; 
  FTransparent := b; 
  invalidate; 
end; 
 
procedure TBmp8.BChange(Sender: TObject); 
begin 
  TBitmap(Sender).pixelformat := pf24bit; 
  makesize(FAuto); 
  invalidate; 
end; 
 
procedure TBmp8.setAlpha(b: byte); 
begin 
  if FAlpha[FLevel] = b then exit; 
  FAlpha[FLevel] := b; 
  FDiff[FLevel] := 255 - b; 
  invalidate; 
end; 
 
function TBmp8.GetAlpha: byte; 
begin 
  result := FAlpha[FLevel]; 
end; 
 
procedure TBmp8.setReveal(s: string); 
begin 
  FReveal := s; 
  invalidate; 
end; 
 
procedure TBmp8.ClearS; 
begin 
  FAuto := 8; 
  standard; 
  clear; 
end; 
 
procedure TBmp8.Clear; 
var 
  x: byte; 
begin 
  for x := 0 to 7 do 
    FArray[x].Free; 
  basis; 
  invalidate; 
end; 
 
procedure TBmp8.build8(a: byte); 
var 
  links, rechts, oben, unten, 
    b3, x, y, zw, zh, w, h, gx, gy: integer; 
  ph, pa: PByteArray; 
  r, g, b: Byte; 
begin 
  try 
    if nopic(a) then exit; 
  except 
    exit; 
  end; 
  w := ord(odd(FArray[a].width) <> Fow); 
  h := ord(odd(FArray[a].height) <> Foh); 
  R := GetRValue(FArray[a].TransparentColor); 
  G := GetGValue(FArray[a].TransparentColor); 
  B := GetBValue(FArray[a].TransparentColor); 
  zw := ord(FArray[a].width < width) * w * 6; 
  zh := ord(FArray[a].height < height) * h * 2; 
  links := (width - FArray[a].width) div 2; 
  rechts := links + FArray[a].width - w; 
  oben := (height - FArray[a].height) div 2; 
  unten := pred(oben + FArray[a].height - h); 
  b3 := FArray[a].width * 3; 
  links := links * 3; 
  rechts := rechts * 3; 
  for y := 0 to FArray[a].height - 1 do begin 
    gy := y + FOffset[a, 1] + oben; 
    if (gy < 0) or (gy >= height) 
      then continue; 
    x := 0; 
    ph := FHintergrund.ScanLine[gy]; 
    pa := FArray[a].scanline[y]; 
    while (x < b3) do begin 
      gx := x + links + FOffset[a, 0] + zw; 
      if (gx >= 0) and (gx < FW3) 
        and (not FArray[a].transparent 
        or (pa[x] <> B) 
        or (pa[x + 1] <> G) 
        or (pa[x + 2] <> R)) 
        then begin 
        if FSolid[a] and (FOpaque[a, 0] = pa[x]) and 
          (FOpaque[a, 1] = pa[x + 1]) and (FOpaque[a, 2] = pa[x + 2]) 
          then begin 
          ph[gx] := pa[x]; 
          ph[gx + 1] := pa[x + 1]; 
          ph[gx + 2] := pa[x + 2]; 
        end else begin 
          ph[gx] := (ph[gx] * FAlpha[a] + pa[x] * FDiff[a]) shr 8; 
          ph[gx + 1] := (ph[gx + 1] * 
            FAlpha[a] + pa[x + 1] * FDiff[a]) shr 8; 
          ph[gx + 2] := (ph[gx + 2] * 
            FAlpha[a] + pa[x + 2] * FDiff[a]) shr 8; 
        end; 
      end; 
      inc(x, 3); 
      if x + FOffset[a, 0] >= rechts then break; 
    end; 
    if y + FOffset[a, 1] - zh >= unten then break; 
  end; 
end; 
 
procedure TBmp8.SaveToStream(stream: TStream); 
var 
  x, y, c: integer; 
begin 
  stream.Position := 0; 
  x := length(FVersion); 
  stream.writebuffer(x, sizeof(Integer)); 
  stream.WriteBuffer(FVersion[1], x); 
  c := color; 
  stream.writebuffer(c, sizeof(Integer)); 
  x := length(FReveal); 
  stream.writebuffer(x, sizeof(Integer)); 
  stream.WriteBuffer(FReveal[1], x); 
  stream.WriteBuffer(Transparent, 1); 
  stream.WriteBuffer(FLevel, 1); 
  stream.WriteBuffer(FAuto, 1); 
  stream.WriteBuffer(width, sizeof(Integer)); 
  stream.WriteBuffer(height, sizeof(Integer)); 
  for x := 0 to 7 do begin 
    stream.writebuffer(FAlpha[x], 1); 
    stream.writebuffer(FSolid[x], 1); 
    for y := 0 to 2 do 
      stream.writebuffer(FOpaque[x, y], 1); 
  end; 
  for x := 0 to 7 do 
    Farray[x].savetostream(stream); 
end; 
 
procedure TBmp8.LoadFromStream(stream: TStream); 
var 
  x, y, c: integer; 
  s: string; 
  b: boolean; 
begin 
  try 
    stream.Position := 0; 
    stream.readbuffer(x, sizeof(Integer)); 
    setlength(s, x); 
    stream.readbuffer(s[1], x); 
    if s <> FVersion then begin 
      notifi('Falsche Version'); 
      exit; 
    end; 
    stream.readbuffer(c, sizeof(Integer)); 
    color := c; 
    stream.readbuffer(x, sizeof(Integer)); 
    setlength(FReveal, x); 
    stream.readbuffer(FReveal[1], x); 
    stream.readbuffer(b, 1); 
    Transparent := b; 
    stream.readbuffer(FLevel, 1); 
    stream.readbuffer(FAuto, 1); 
    stream.readbuffer(c, sizeof(Integer)); 
    width := c; 
    stream.readbuffer(c, sizeof(Integer)); 
    height := c; 
    for x := 0 to 7 do begin 
      stream.readbuffer(FAlpha[x], 1); 
      FDiff[x] := 255 - FAlpha[x]; 
      stream.readbuffer(FSolid[x], 1); 
      for y := 0 to 2 do 
        stream.readbuffer(FOpaque[x, y], 1); 
    end; 
    for x := 0 to 7 do 
      FArray[x].loadfromstream(stream); 
    invalidate; 
  except 
    notifi('Fehler beim Laden!'); 
  end; 
end; 
 
procedure TBmp8.SavetoFile(const FileName: string); 
begin 
  FS := TFileStream.create(FileName, fmCreate or fmShareExclusive); 
  SaveToStream(FS); 
  Fs.free; 
end; 
 
procedure TBmp8.LoadFromFile(const FileName: string); 
begin 
  FS := TFileStream.create(FileName, fmOpenRead or fmShareExclusive); 
  LoadFromStream(FS); 
  Fs.free; 
end; 
 
procedure TBmp8.SaveAsBitmap(const FileName: string); 
var 
  bmp: TBitmap; 
begin 
  if visible then begin 
    bmp := TBitmap.create; 
    bmp.width := width; 
    bmp.height := height; 
    paint; 
    drauf(bmp.canvas); 
    bmp.savetofile(FileName); 
    bmp.free; 
  end else 
    notifi('Unsichtbare Bilder können nicht gespeichert werden.'); 
end; 
 
procedure TBmp8.notifi(txt: string); 
begin 
  messagebox(0, PChar(txt + '   '), 'BMP8', MB_ICONERROR); 
end; 
 
procedure TBmp8.setSolid(b: boolean); 
begin 
  if b = FSolid[FLevel] then exit; 
  FSolid[FLevel] := b; 
  invalidate; 
end; 
 
function TBmp8.getsolid: boolean; 
begin 
  result := FSolid[FLevel]; 
end; 
 
procedure TBmp8.setOpaque(c: TColor); 
var 
  f: TColor; 
begin 
  f := ColorToRGB(c); 
  FOpaque[FLevel][0] := GetBValue(f); 
  FOpaque[FLevel][1] := GetGValue(f); 
  FOpaque[FLevel][2] := GetRValue(f); 
  invalidate; 
end; 
 
function TBmp8.getOpaque: TColor; 
begin 
  result := RGB(FOpaque[FLevel][2], FOpaque[FLevel][1], FOpaque[FLevel][0]); 
end; 
 
function TBmp8.nopic(w: byte): boolean; 
begin 
  result := (FArray[w] = nil) or FArray[w].empty 
    or (FArray[w].width < 1) or (FArray[w].height < 1); 
end; 
 
procedure TBmp8.standard; 
begin 
  width := 150; 
  height := 150; 
end; 
 
procedure TBmp8.anpassen(b: byte); 
begin 
  width := FArray[b].width; 
  height := FArray[b].height; 
end; 
 
procedure TBmp8.makesize(b: byte); 
begin 
  FAuto := b; 
  if b > 8 then standard 
  else begin 
    try 
      if nopic(b) then exit; 
    except 
      exit; 
    end; 
    anpassen(b); 
  end; 
  invalidate; 
end; 
 
procedure TBmp8.setAuto(b: byte); 
begin 
  if b = FAuto then exit; 
  makesize(b); 
end; 
 
procedure TBmp8.Resize; 
begin 
  makesize(FAuto); 
end; 
 
procedure TBmp8.setoffx(i: integer); 
begin 
  FOffset[FLevel, 0] := i * 3; 
  invalidate; 
end; 
 
function TBmp8.getoffx: integer; 
begin 
  result := FOffset[FLevel, 0] div 3; 
end; 
 
procedure TBmp8.setoffy(i: integer); 
begin 
  FOffset[FLevel, 1] := i; 
  invalidate; 
end; 
 
function TBmp8.getoffy: integer; 
begin 
  result := FOffset[FLevel, 1]; 
end; 
 
procedure TBmp8.setlevel(b: byte); 
begin 
  if (csReading in Componentstate) 
    or (csLoading in Componentstate) 
    or Flag 
    then begin 
    if b > 7 then b := 7; 
    Flag := True; 
    if FLevel = b then exit; 
    FLevel := b; 
    invalidate; 
  end; 
end; 
 
function TBmp8.Bitmaps: Byte; 
var 
  x: byte; 
begin 
  result := 0; 
  for x := 0 to 7 do begin 
    try 
      if not nopic(x) then 
        inc(result); 
    except end; 
  end; 
end; 
 
procedure TBmp8.PChange(Sender: TObject); 
begin 
  makepicture(FPic); 
end; 
 
end.