View Single Post
Sfaizst

JCF Member

Joined: Mar 2008

Posts: 99

Sfaizst is an asset to this forum

Jul 9, 2011, 05:51 AM
Sfaizst is offline
Reply With Quote
My first and crappy old source for reading the tileset-pic itself out of a tileset, I'm currently working on new reader units (with classes,...), but this can helpful for pascal / delphi beginners (even if its not very good written) that want to try to decrypt the fileformats


JJFHack.pas: Mainly for reading and uncompressing zlib-compressed files (used ZlibEx for uncompressing, normal zlib should work as well):
Code:
unit JJFHack;



interface



uses

  SysUtils, Classes, StdCtrls, ZLibEx;






Function StartJJF(FileName:String):Boolean;

procedure LoadBinary(var Memo:TMemo);

procedure LoadBinaryFunc(var Data; Count:Cardinal; Memo:TMemo);

function GetZlibStreamPos:Integer;

procedure AddZlibStreamPos(Position : Integer);

procedure GetCVar(const Position:Integer);

function ReadCVar(Number:Integer):Integer;

procedure GetUVar(const Position:Integer);

function Uncompress(const Index:Integer; MemoryStream:TMemoryStream):Boolean;

function Compress(var MemoryStream:TMemoryStream; const Index:Integer):Boolean;

function ReadString(var MemoryStream:TMemorystream; const Position, StrLength : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False):AnsiString;

procedure WriteString(var MemoryStream:TMemorystream; InputStr : Ansistring; const Position, StrLength : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False);

function ReadInteger(var MemoryStream:TMemorystream; const Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False):Integer;

procedure WriteInteger(var MemoryStream:TMemorystream; const InputInt, Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False);

function ReadWord(var MemoryStream:TMemorystream; const Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False):Word;

procedure WriteWord(var MemoryStream:TMemorystream; const InputWord:Word; Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False);

procedure WriteByte(var MemoryStream:TMemorystream; const InputByte:Byte; Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False);

function ReadByte(var MemoryStream:TMemorystream; const Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False):Byte;

Procedure FreeJJF;



var

FStream : TFileStream;

ZLList, CList, UList : TStringlist;



implementation





//File in einen Stream Laden

Function StartJJF(FileName:String):Boolean;

begin

  ZLList := TStringlist.Create;

  CList := TStringlist.Create;

  UList := TStringlist.Create;

  try

  FStream := TFileStream.Create(FileName,fmOpenReadWrite);

  Result := True;

  except

  Result := False;

  end;

end;



//Lädt einen Stream in Memo (aufruf: LoadBinaryFunc(MS.Memory^,MS.Size,Memo)

procedure LoadBinaryFunc(var Data; Count: Cardinal; Memo: TMemo);

var

  line: string[80];

  i: Cardinal;

  p: PAnsiChar;

  nStr: string[4];

const

  posStart = 1;

  binStart = 7;

  ascStart = 57;

  HexChars: PAnsiChar = '0123456789ABCDEF';

begin



  p    := @Data;

  line := '';

  for i := 0 to Count - 1 do

  begin

    if (i mod 16) = 0 then

    begin

      if Length(line) > 0 then

        Memo.Lines.Add(line);

      FillChar(line, SizeOf(line), ' ');

      line[0] := Chr(72);

      nStr    := Format('%4.4X', [i]);

      Move(nStr[1], line[posStart], Length(nStr));

      line[posStart + 4] := ':';

    end;

    if p[i] >= ' ' then

      line[i mod 16 + ascStart] := p[i]

    else

      line[i mod 16 + ascStart] := '.';

    line[binStart + 3 * (i mod 16)]     := HexChars[(Ord(p[i]) shr 4) and $F];

    line[binStart + 3 * (i mod 16) + 1] := HexChars[Ord(p[i]) and $F];

  end;

  Memo.Lines.Add(line);

end;



//Lädt Momentan genutzen FileStream in Memo

procedure LoadBinary(var Memo:TMemo);

var MStream:TMemoryStream;

begin

  MStream.Create;

  try

    MStream.LoadFromStream(FStream);

    LoadBinaryFunc(MStream.Memory^,MStream.Size,Memo);

  finally

    MStream.Free;

  end;

end;



//Speichert Adressen der Komprimierten Streams in Stringlist, Rückgabewert: Anzahl

function GetZlibStreamPos:Integer;

var

I, I2 : Integer;

B1, B2 : Byte;

begin

  ZLList.Clear;

  I2 := 0;

       for I := 0 to FStream.Size do

           begin

             FStream.Seek(I,soFromBeginning);

             FStream.Read(B1,1);

             FStream.Seek(I+1,soFromBeginning);

             FStream.Read(B2,1);

             if (B1=$78) and (B2=$DA) then

                begin

                  I2 := I2+1;

                  ZLList.Add(IntToStr(I));

                end;

           end;

       Result := I2;

end;



procedure AddZlibStreamPos(Position : Integer);

begin

  ZLList.Add(IntToStr(Position));

end;



//Speichert Länge des komprimierten Sterams in StringList

procedure GetCVar(const Position:Integer);

var TmpInt : Integer;

begin

   FStream.Seek(Position,soFromBeginning);

   FStream.Read(TmpInt,4);

   FStream.Seek(0,soFromBeginning);

   CList.Add(IntToStr(TmPInt));

end;



function ReadCVar(Number:Integer):Integer;

begin

  Result := StrToInt(Clist[Number]);

end;



//Speichert Länge des unkomprimierten Streams in StringList (nicht zwingend notwendig)

procedure GetUVar(const Position:Integer);

var TmpInt : Integer;

begin

   FStream.Seek(Position,soFromBeginning);

   FStream.Read(TmpInt,4);

   FStream.Seek(0,soFromBeginning);

   UList.Add(IntToStr(TmPInt));

end;



//Dekomprimiert, Ausgabe sind MemoryStream und Boolean obs geklappt hat

function Uncompress(const Index:Integer; MemoryStream:TMemoryStream):Boolean;

var

InChr : PAnsiChar;

OutBuf : Pointer;

OutBytes : Integer;

begin

  try

    InChr := AllocMem(StrToInt(CList[Index]));

    fStream.Seek(StrtoInt(ZLList[Index]),soFromBeginning);

    fStream.Read(InChr^,StrToInt(CList[Index]));

    fStream.Seek(0,soFromBeginning);

    ZDecompress(InChr,StrToInt(CList[Index]),OutBuf,OutBytes);

    MemoryStream.Write(OutBuf^, OutBytes);

    if (UList[Index] <> '') and (OutBytes=StrToInt(UList[Index])) then

       Result := True Else

       Result := False;

  except

    Result := False;

  end;

end;



//Komprimiert, Ausgabe gibts obs geklappt hat und der neue String gleich lang ist

function Compress(var MemoryStream:TMemoryStream; const Index:Integer):Boolean;

var

InChr : PAnsiChar;

OutBuf : Pointer;

OutBytes : Integer;

begin

  try

    InChr := AllocMem(MemoryStream.Size);

    MemoryStream.Position := 0;

    MemoryStream.Read(InChr^,MemoryStream.Size);

    MemoryStream.Position := 0;

    ZCompress(InChr,MemoryStream.Size,OutBuf,OutBytes,zcLevel9);

    fStream.Seek(StrtoInt(ZLList[Index]),soFromBeginning);

    fStream.Write(OutBuf^,OutBytes);

    fStream.Seek(0,soFromBeginning);

    if (CList[Index] <> '') and (OutBytes=StrToInt(CList[Index])) then

       Result := True Else

       Result := False;

  except

    Result := False;

  end;

end;



//Lese String aus Stream, var MemoryStream wird ignoriert wenn Filestream genutzt wird

function ReadString(var MemoryStream:TMemorystream;

         const Position, StrLength : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False):AnsiString;

var TmpStr : AnsiString;

begin

  if UseFileStream = True then

     begin

       if NotReadLast = False then

       FStream.Seek(Position,soFromBeginning);

       SetLength(TmpStr,StrLength);

       FStream.Read(TmpStr[1],StrLength);

       if NotSetBack = False then

       FStream.Seek(0,soFromBeginning);

     end Else

     begin

       if NotReadLast = False then

       MemoryStream.Position:=Position;

       SetLength(TmpStr,StrLength);

       MemoryStream.Read(TmpStr[1],StrLength);

       if NotSetBack = False then

       MemoryStream.Position:=0;

     end;

       Result := TmpStr;

end;



//Schreibe String in den entsperchenden Stream

procedure WriteString(var MemoryStream:TMemorystream; InputStr : Ansistring;

          const Position, StrLength : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False);

begin

  if Length(InputStr) > StrLength then

     SetLength(InputStr,StrLength);

  if UseFileStream = True then

     begin

       if NotReadLast = False then

       FStream.Seek(Position,soFromBeginning);

       FStream.Write(PChar(InputStr)^,StrLength);

       if NotSetBack = False then

       FStream.Seek(0,soFromBeginning);

     end Else

     begin

       if NotReadLast = False then

       MemoryStream.Position:=Position;

       MemoryStream.Write(PChar(InputStr)^,StrLength);

       if NotSetBack = False then

       MemoryStream.Position:=0;

     end;

end;



//Lese Integer aus Stream

function ReadInteger(var MemoryStream:TMemorystream;

         const Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False):Integer;

begin

  if UseFileStream = True then

     begin

       if NotReadLast = False then

       FStream.Seek(Position,soFromBeginning);

       FStream.Read(Result,4);

       if NotSetBack = False then

       FStream.Seek(0,soFromBeginning);

     end Else

     begin

       if NotReadLast = False then

       MemoryStream.Position:=Position;

       MemoryStream.Read(Result,4);

       if NotSetBack = False then

       MemoryStream.Position:=0;

     end;

end;



//Schreibe Integer in den entsprechende Stream

procedure WriteInteger(var MemoryStream:TMemorystream;

         const InputInt, Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False);

begin

  if UseFileStream = True then

     begin

       if NotReadLast = False then

       FStream.Seek(Position,soFromBeginning);

       FStream.Write(InputInt,4);

       if NotSetBack = False then

       FStream.Seek(0,soFromBeginning);

     end Else

     begin

       if NotReadLast = False then

       MemoryStream.Position:=Position;

       MemoryStream.Write(InputInt,4);

       if NotSetBack = False then

       MemoryStream.Position:=0;

     end;

end;



//Read Word aus Stream

function ReadWord(var MemoryStream:TMemorystream;

         const Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False):Word;

begin

  if UseFileStream = True then

     begin

       if NotReadLast = False then

       FStream.Seek(Position,soFromBeginning);

       FStream.Read(Result,2);

       if NotSetBack = False then

       FStream.Seek(0,soFromBeginning);

     end Else

     begin

       if NotReadLast = False then

       MemoryStream.Position:=Position;

       MemoryStream.Read(Result,2);

       if NotSetBack = False then

       MemoryStream.Position:=0;

     end;

end;



//Schreibe Word in den entsprechende Stream

procedure WriteWord(var MemoryStream:TMemorystream;

         const InputWord:Word; Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False);

begin

  if UseFileStream = True then

     begin

       if NotReadLast = False then

       FStream.Seek(Position,soFromBeginning);

       FStream.Write(InputWord,2);

       if NotSetBack = False then

       FStream.Seek(0,soFromBeginning);

     end Else

     begin

       if NotReadLast = False then

       MemoryStream.Position:=Position;

       MemoryStream.Write(InputWord,2);

       if NotSetBack = False then

       MemoryStream.Position:=0;

     end;

end;



//Read Byte aus Stream, var MemoryStream wird ignoriert wenn Filestream genutzt wird

function ReadByte(var MemoryStream:TMemorystream;

         const Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False):Byte;

begin

  if UseFileStream = True then

     begin

       if NotReadLast = False then

       FStream.Seek(Position,soFromBeginning);

       FStream.Read(Result,1);

       if NotSetBack = False then

       FStream.Seek(0,soFromBeginning);

     end Else

     begin

       if NotReadLast = False then

       MemoryStream.Position:=Position;

       MemoryStream.Read(Result,1);

       if NotSetBack = False then

       MemoryStream.Position:=0;

     end;

end;



//Schreibe Word in den entsprechende Stream

procedure WriteByte(var MemoryStream:TMemorystream;

         const InputByte:Byte; Position : Integer; UseFilestream:Boolean=False;NotReadLast:Boolean=False;NotSetBack:Boolean=False);

begin

  if UseFileStream = True then

     begin

       if NotReadLast = False then

       FStream.Seek(Position,soFromBeginning);

       FStream.Write(InputByte,1);

       if NotSetBack = False then

       FStream.Seek(0,soFromBeginning);

     end Else

     begin

       if NotReadLast = False then

       MemoryStream.Position:=Position;

       MemoryStream.Write(InputByte,1);

       if NotSetBack = False then

       MemoryStream.Position:=0;

     end;

end;



//Schreibe das File und schließe alle offenen Streams (der komponente!)

procedure FreeJJF;

begin

   try

     FStream.Free;

   except

   end;

   try

     ZLList.Free;

   except

   end;

   try

     CList.Free;

   except

   end;

   try

     UList.Free;

   except

   end;

end;



end.
JJFhackTileSet.pas For reading Tileset informations, never finished it completly (used GR32 Images suite), i think the mask part is not working :
Code:
unit JJFHackTileset;



interface



uses JJFhack, Math, SysUtils, Classes, StdCtrls, Messages,Windows,

     Graphics, GR32, ImgList ,Controls;



type TBit = 0..1;



Function OpenTileSet(const TileSetFileName : String):Byte;

Procedure ReadDataStream(const StreamNumber : Byte);

Procedure ReadPalette;

Function GetUsed_Tiles:Integer;

Procedure GetTileAddr;

Procedure GetMaskAddr;

Procedure GetTileSetImage;

Procedure GetMaskVars;

Procedure GetMaskImage;

Procedure LoadTiles(Bitmap:TBitmap32);

Procedure LoadTiles2(Bitmap:TBitmap);

Procedure LoadTilestoList(ImgList:TImageList);

procedure FlipList(ImgList,FlippedImgList:TImageList);

Procedure LoadMask(Bitmap:TBitmap);

Procedure FreeTileSet;



var

MAX_TILES : Integer;

DataStream : Array [0..3] of TMemoryStream;

DataStreamBool : Array [0..3] of Boolean;

Palette : Array [0..255,0..2] of Byte;

TileAddr,MaskAddr : Array of Integer;

TileColorArray : Array of Array [0..1023] of Array [0..2] of Byte;

MaskColorArray : Array of Array [0..1023] of TColor;

MaskBoolArray : Array of Boolean;

TileSetName : AnsiString;



type

  TRGBArray = array[0..0] of TRGBTriple;

  pRGBArray = ^TRGBArray;



implementation



function Significance(DigitNr: Byte; Base: Byte): integer; overload;

begin

  result := Round(Power(Base,DigitNr));

end;



function Significance(BitNr: Byte): integer; overload;

begin

  result := Round(Significance(BitNr,2));

end;



function GetBit(Value: longint; BitNr: Byte): TBit;

begin

  result := Value and Significance(BitNr);

end;



function BitToBool(Bit: TBit): Boolean;

begin

  case Bit of

    0: result := False;

    1: result := True;

  end;

end;



function RGB2TColor(R, G, B: Byte): Integer;

begin

  // convert hexa-decimal values to RGB

  Result := R or (G shl 8) or (B shl 16);  // ich mochte das OR halt viel lieber

end;



Function OpenTileSet(const TileSetFileName : String):Byte;

var

Tmp : TMemoryStream; //Temporary, this is not used

FVersion : Word; //TileSetVersion

begin

  If JJFHack.StartJJF(TileSetFileName) = False then

     begin Result := 1; JJFHack.FreeJJF; end Else

     begin

  If JJFHack.ReadString(Tmp,180,4,True) <> 'TILE' then

     begin Result := 2; JJFHack.FreeJJF; end Else

     begin

     TileSetname := JJFHack.ReadString(Tmp,188,32,True);

     FVersion := JJFHack.ReadWord(Tmp,220,True);

  If FVersion = $200 then

     MAX_TILES := 1024 Else

  If FVersion = $201 then

     MAX_TILES := 4096 Else

     begin

       Result := 3;

       JJFHack.FreeJJF;

       exit;

     end;

        //Informations for Data1:

         JJFhack.GetCVar($E6);

         JJFhack.GetUVar($EA);

         JJFHack.AddZlibStreamPos($106);

       //Informations for Data2:

         JJFhack.GetCVar($EE);

         JJFhack.GetUVar($F2);

         JJFHack.AddZlibStreamPos($106+JJFHack.ReadCVar(0));

       //Informations for Data3:

         JJFhack.GetCVar($F6);

         JJFhack.GetUVar($FA);

         JJFHack.AddZlibStreamPos($106+JJFHack.ReadCVar(0)+JJFHack.ReadCVar(1));

       //Informations for Data4:

         JJFhack.GetCVar($FE);

         JJFhack.GetUVar($102);

         JJFHack.AddZlibStreamPos($106+JJFHack.ReadCVar(0)+JJFHack.ReadCVar(1)+JJFHack.ReadCVar(2));

     Result := 0;

     end;

     end;



end;



Procedure ReadDataStream(const StreamNumber : Byte);

begin

 if DataStreamBool[StreamNumber] = False then

 begin

 DataStream[StreamNumber] := TMemoryStream.Create;

 JJFHack.Uncompress(StreamNumber,DataStream[StreamNumber]);

 end;

 DataStreamBool[StreamNumber] := True;

end;



Procedure ReadPalette;

var

I : Integer;

begin

  ReadDataStream(0);

  for I := 0 to Length(Palette) - 1 do

      begin

        Palette[I,0] := JJFHack.ReadByte(DataStream[0],I*4);

        Palette[I,1] := JJFHack.ReadByte(DataStream[0],1+I*4);

        Palette[I,2] := JJFHack.ReadByte(DataStream[0],2+I*4);

      end;

end;



Function GetUsed_Tiles:Integer;

begin

  ReadDataStream(0);

  Result := JJFHack.ReadInteger(DataStream[0],$400);

end;



Procedure GetTileAddr;

var

TmPAddr, I : Integer;

begin

  ReadDataStream(0);

  TmpAddr := $404 + (2*MAX_TILES);

  SetLength(TileAddr,GetUsed_Tiles);

  for I := 0 to Length(TileAddr) - 1 do

      TileAddr[I] := JJFHack.ReadInteger(DataStream[0],TmpAddr+(I*4));

end;



Procedure GetMaskAddr;

var

TmPAddr, I : Integer;

begin

  ReadDataStream(0);

  TmpAddr := $404 + (10*MAX_TILES);

  SetLength(MaskAddr,GetUsed_Tiles);

  for I := 0 to Length(MaskAddr) - 1 do

      MaskAddr[I] := JJFHack.ReadInteger(DataStream[0],TmpAddr+(I*4));

end;



Procedure GetTileSetImage;

var I, I2 : Integer;

begin

  ReadPalette;

  GetTileAddr;

  SetLength(TileColorArray,GetUsed_Tiles);

  ReadDataStream(1);

  for I := 0 to Length(TileAddr) - 1 do

      begin

        for I2 := 0 to 1023 do

            begin

             TileColorArray[I,I2,0] := Palette[JJFHack.ReadByte(DataStream[1],TileAddr[I]+I2),0];

             TileColorArray[I,I2,1] := Palette[JJFHack.ReadByte(DataStream[1],TileAddr[I]+I2),1];

             TileColorArray[I,I2,2] := Palette[JJFHack.ReadByte(DataStream[1],TileAddr[I]+I2),2];

            end;

      end;

end;



Procedure GetMaskVars;

var

I, I2, I3, TmPInt, I4 : Integer;

B1, B0 :Byte;

begin

  I4 := 0;

  GetMaskAddr;

  ReadDataStream(2);

  SetLength(MaskBoolArray,Length(MaskAddr)*1024);

  for I := 0 to Length(MaskAddr) - 1 do

      begin

        for I2 := 0 to 31 do

            begin

             TmPInt := JJFHack.ReadInteger(DataStream[2],MaskAddr[I]+(I2*4));

             for I3 := 0 to 31 do

                 begin

                 MaskBoolArray[I4] := BitToBool(GetBit(TmPInt,I3));

                 I4 := I4 +1;

                 end;

            end;

      end;

end;



Procedure GetMaskImage;

var I, I2 : Integer;

begin

  GetMaskVars;

  SetLength(MaskColorArray,Length(MaskAddr));

  for I := 0 to Length(MaskAddr) do

      begin

        for I2 := 0 to 1023 do

            begin

            if MaskBoolArray[MaskAddr[I]+I2] = True then

                MaskColorArray[I,I2] := $FFFFFF Else

                MaskColorArray[I,I2] := $000000;

            end;

      end;

end;



Procedure LoadTiles(Bitmap:TBitmap32);

var

I, I2, TilePosX, TilePosY, X, Y : Integer;

LogPal  : TMaxLogPalette;

hPal : hPalette;

PLogPal : PLogPalette;

begin

   GetTileSetImage;

   Bitmap.Width := 320;

   Bitmap.Height := (Length(TileAddr)Div 10)*32;

   with LogPal do begin

        palVersion:=$0300;

        palNumEntries:=256;

        for i:=0 to 255 do begin

            with palPalEntry[i] do begin

                 peRed  := Palette[I,0];

                 peGreen:= Palette[I,1];

                 peBlue := Palette[I,2];

                 peFlags:=0;

            end;

       end;

   end;

   pLogPal:=@LogPal;

   hPal:=CreatePalette(pLogPal^);

   //Bitmap.PixelFormat:=pf8Bit;

   //Bitmap.Palette:=hPal;

         for I2 := 0 to Length(TileAddr)-1 do

          begin

          if I2 = 0 then

             begin

               TilePosX := 0;

               TilePosY := 0;

             end Else

             begin

          if TilePosX < 9 then

             TilePosX := TilePosX+1 Else

             begin

               TilePosX := 0;

               TilePosY := TilePosY+1;

             end;

             end;



          for I := 0 to 1023 do

              begin

                if I = 0 then

                   begin

                     x := 0;

                     y := 0;

                   end Else

                   begin

                     if x < 31 then

                        x := x +1 Else

                     begin

                        x := 0;

                        y := y+1;

                     end;

                   end;

               Bitmap.Canvas.Pixels[X+(TilePosX*32),Y+(TilePosY*32)] := RGB2TColor(TileColorArray[I2,I,0],TileColorArray[I2,I,1],TileColorArray[I2,I,2]);

              end;

          end;

end;



Procedure LoadTiles2(Bitmap:TBitmap);

var

I, I2, TilePosX, TilePosY, X, Y : Integer;

LogPal  : TMaxLogPalette;

hPal : hPalette;

PLogPal : PLogPalette;

begin

   GetTileSetImage;

   Bitmap.Width := 320;

   Bitmap.Height := (Length(TileAddr)Div 10)*32;

   with LogPal do begin

        palVersion:=$0300;

        palNumEntries:=256;

        for i:=0 to 255 do begin

            with palPalEntry[i] do begin

                 peRed  := Palette[I,0];

                 peGreen:= Palette[I,1];

                 peBlue := Palette[I,2];

                 peFlags:=0;

            end;

       end;

   end;

   pLogPal:=@LogPal;

   hPal:=CreatePalette(pLogPal^);

   //Bitmap.PixelFormat:=pf8Bit;

   //Bitmap.Palette:=hPal;

         for I2 := 0 to Length(TileAddr)-1 do

          begin

          if I2 = 0 then

             begin

               TilePosX := 0;

               TilePosY := 0;

             end Else

             begin

          if TilePosX < 9 then

             TilePosX := TilePosX+1 Else

             begin

               TilePosX := 0;

               TilePosY := TilePosY+1;

             end;

             end;



          for I := 0 to 1023 do

              begin

                if I = 0 then

                   begin

                     x := 0;

                     y := 0;

                   end Else

                   begin

                     if x < 31 then

                        x := x +1 Else

                     begin

                        x := 0;

                        y := y+1;

                     end;

                   end;

               Bitmap.Canvas.Pixels[X+(TilePosX*32),Y+(TilePosY*32)] := RGB2TColor(TileColorArray[I2,I,0],TileColorArray[I2,I,1],TileColorArray[I2,I,2]);

              end;

          end;

end;



Procedure LoadTilestoList(ImgList:TImageList);

var

I, I2, X, Y : Integer;

LogPal  : TMaxLogPalette;

hPal : hPalette;

PLogPal : PLogPalette;

Bitmap : TBitmap;

begin

   Bitmap := TBitmap.Create;

   try

   GetTileSetImage;

   Bitmap.Width := 32;

   Bitmap.Height := 32;

   {Bitmap.Width := 320;

   Bitmap.Height := (Length(TileAddr)Div 10)*32;   }

   with LogPal do begin

        palVersion:=$0300;

        palNumEntries:=256;

        for i:=0 to 255 do begin

            with palPalEntry[i] do begin

                 peRed  := Palette[I,0];

                 peGreen:= Palette[I,1];

                 peBlue := Palette[I,2];

                 peFlags:=0;

            end;

       end;

   end;

   pLogPal:=@LogPal;

   hPal:=CreatePalette(pLogPal^);

   Bitmap.PixelFormat:=pf8Bit;

   Bitmap.Palette:=hPal;

         for I2 := 0 to Length(TileAddr)-1 do

          begin

          for I := 0 to 1023 do

              begin

                if I = 0 then

                   begin

                     x := 0;

                     y := 0;

                   end Else

                   begin

                     if x < 31 then

                        x := x +1 Else

                     begin

                        x := 0;

                        y := y+1;

                     end;

                   end;

               Bitmap.Canvas.Pixels[X,Y] := RGB2TColor(TileColorArray[I2,I,0],TileColorArray[I2,I,1],TileColorArray[I2,I,2]);

              end;

               ImgList.Add(Bitmap,Nil);

          end;

   finally

     Bitmap.Free;

   end;

end;



//Flip einzelnes Img:

procedure FlipImg(const Bitmap: TBitmap);

var  Pict:TBitmap;

begin

  (* neue Bitmap erzeugen *)

  Pict:=TBitmap.Create;

  (* zu spiegelnde Bitmap zuweisen *)

  Pict.Assign(Bitmap);

  //Vertical:

  StretchBlt(Pict.Canvas.Handle, 0, 0, Pict.Width,

    Pict.Height, Bitmap.Canvas.Handle,

    Bitmap.Width-1, 0, -Bitmap.Width, Bitmap.Height, srccopy);

  //Horzontal:

  {

  StretchBlt(Pict.Canvas.Handle, 0, 0,

    Pict.Width, Pict.Height, Bitmap.Canvas.Handle,

    0, Bitmap.Height-1, Bitmap.Width, -Bitmap.Height, srccopy);     }



  (* das Alte gegen das Neue Bild austauschen *)

  Bitmap.Assign(Pict);

  Pict.Free



end;



procedure FlipList(ImgList,FlippedImgList:TImageList);

var

  TmpBmp: TBitmap;

  I: Integer;

begin

  TmpBmp := TBitmap.Create;

  TmpBmp.Height :=32;

  TmpBmp.Width :=32;

  try

  for I := 0 to ImgList.Count - 1 do

      begin

        ImgList.GetBitmap(I,TmpBmp);

        FlipImg(TmpBmp);

        FlippedImgList.Add(TmpBmp,nil);

      end;

  finally

    TmpBmp.Free;

  end;

end;



Procedure LoadMask(Bitmap:TBitmap);

var I, I2, X, Y, TilePosX, TilePosY : Integer;

begin

  GetMaskImage;

  Bitmap.Width := 320;

  Bitmap.Height := (Length(MaskAddr)Div 10)*32;

  Bitmap.PixelFormat:=pf8Bit;

         for I2 := 0 to Length(MaskAddr)-1 do

          begin

          if I2 = 0 then

             begin

               TilePosX := 0;

               TilePosY := 0;

             end Else

             begin

          if TilePosX < 9 then

             TilePosX := TilePosX+1 Else

             begin

               TilePosX := 0;

               TilePosY := TilePosY+1;

             end;

             end;



          for I := 0 to 1023 do

              begin

                if I = 0 then

                   begin

                     x := 0;

                     y := 0;

                   end Else

                   begin

                     if x < 31 then

                        x := x +1 Else

                     begin

                        x := 0;

                        y := y+1;

                     end;

                   end;

               Bitmap.Canvas.Pixels[X+(TilePosX*32),Y+(TilePosY*32)] := MaskColorArray[I2,I];

              end;

          end;

end;



Procedure FreeTileSet;

var I:Integer;

begin

  for I := 0 to 3 do

      begin

        DataStream[I].Free;

        DataStreamBool[I] := False;

      end;

  JJFHack.FreeJJF;

end;



end.
__________________

I'm watching you!!

Last edited by Sfaizst; Jul 9, 2011 at 06:03 AM.