| Sfaizst |
Jul 9, 2011 04:51 AM |
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 :D:
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.
|
