1
0
mirror of https://github.com/moparisthebest/Simba synced 2025-01-10 21:28:00 -05:00

FIXED YO ERRORS!

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@48 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-09-13 05:00:13 +00:00
parent 5ca4ac75e1
commit dee2b98fd9

View File

@ -1,322 +1,328 @@
unit bitmaps; unit bitmaps;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, FPImgCanv,FPImage,IntfGraphics,graphtype,MufasaTypes ,graphics; Classes, SysUtils, FPImgCanv,FPImage,IntfGraphics,graphtype,MufasaTypes ,graphics;
type type
{ TMufasaBitmap } { TMufasaBitmap }
TMufasaBitmap = class(TObject) TMufasaBitmap = class(TObject)
private private
w,h : integer; w,h : integer;
public public
FData : PRGB32; FData : PRGB32;
procedure SetSize(AWidth,AHeight : integer); procedure SetSize(AWidth,AHeight : integer);
property Width : Integer read w; property Width : Integer read w;
property Height : Integer read h; property Height : Integer read h;
function SaveToFile(const FileName : string) :boolean; function SaveToFile(const FileName : string) :boolean;
procedure LoadFromFile(const FileName : string); procedure LoadFromFile(const FileName : string);
constructor Create; constructor Create;
destructor Destroy;override; destructor Destroy;override;
end; end;
TMufasaBmpArray = Array of TMufasaBitmap; TMufasaBmpArray = Array of TMufasaBitmap;
{ TMBitmaps } { TMBitmaps }
TMBitmaps = class(TObject) TMBitmaps = class(TObject)
protected protected
Client : TObject; Client : TObject;
FreeSpots : Array of integer; FreeSpots : Array of integer;
BmpArray : TMufasaBmpArray; BmpArray : TMufasaBmpArray;
BmpsCurr,BmpsHigh,FreeSpotsHigh,FreeSpotsLen : integer; BmpsCurr,BmpsHigh,FreeSpotsHigh,FreeSpotsLen : integer;
public public
function GetBMP(Index : integer) : TMufasaBitmap; function GetBMP(Index : integer) : TMufasaBitmap;
property Bmp[Index : integer]: TMufasaBitmap read GetBMP; property Bmp[Index : integer]: TMufasaBitmap read GetBMP;
function CreateBMP(w, h: integer): Integer; function CreateBMP(w, h: integer): Integer;
function CreateMirroredBitmap(bitmap: Integer): Integer; function CreateMirroredBitmap(bitmap: Integer): Integer;
function CreateBMPFromFile(const Path : string) : integer; function CreateBMPFromFile(const Path : string) : integer;
function CreateBMPFromString(width,height : integer; Data : string) : integer; function CreateBMPFromString(width,height : integer; Data : string) : integer;
procedure FreeBMP( Number : integer); procedure FreeBMP( Number : integer);
constructor Create(Owner : TObject); constructor Create(Owner : TObject);
destructor Destroy;override; destructor Destroy;override;
end; end;
implementation implementation
uses uses
Windowutil,paszlib,DCPbase64; Windowutil,paszlib,DCPbase64;
{ TMBitmaps } { TMBitmaps }
function TMBitmaps.GetBMP(Index: integer): TMufasaBitmap; function TMBitmaps.GetBMP(Index: integer): TMufasaBitmap;
begin begin
if (Index >= 0) and (Index <= BmpsCurr) then if (Index >= 0) and (Index <= BmpsCurr) then
if BmpArray[Index] <> nil then if BmpArray[Index] <> nil then
Result := BmpArray[Index]; Result := BmpArray[Index];
end; end;
function TMBitmaps.CreateBMP(w,h : integer): Integer; function TMBitmaps.CreateBMP(w,h : integer): Integer;
begin begin
if BmpsCurr < BmpsHigh then if BmpsCurr < BmpsHigh then
begin; begin;
inc(BmpsCurr); inc(BmpsCurr);
Result := BmpsCurr; Result := BmpsCurr;
end else if (FreeSpotsHigh > -1) then end else if (FreeSpotsHigh > -1) then
begin; begin;
Result := FreeSpots[FreeSpotsHigh]; Result := FreeSpots[FreeSpotsHigh];
dec(FreeSpotsHigh); dec(FreeSpotsHigh);
end else end else
begin; begin;
SetLength(BmpArray, BmpsHigh + 6); SetLength(BmpArray, BmpsHigh + 6);
BmpsHigh := BmpsHigh + 5; BmpsHigh := BmpsHigh + 5;
inc(BmpsCurr); inc(BmpsCurr);
Result := BmpsCurr; Result := BmpsCurr;
end; end;
BmpArray[Result] := TMufasaBitmap.Create; BmpArray[Result] := TMufasaBitmap.Create;
BmpArray[Result].SetSize(w,h); BmpArray[Result].SetSize(w,h);
end; end;
function TMBitmaps.CreateMirroredBitmap(bitmap: Integer): Integer; function TMBitmaps.CreateMirroredBitmap(bitmap: Integer): Integer;
var var
w,h : integer; w,h : integer;
y,x : integer; y,x : integer;
Source,Dest : PRGB32; Source,Dest : PRGB32;
begin begin
Source := Bmp[Bitmap].FData; Source := Bmp[Bitmap].FData;
w := BmpArray[Bitmap].Width; w := BmpArray[Bitmap].Width;
h := BmpArray[Bitmap].Height; h := BmpArray[Bitmap].Height;
Result := CreateBMP(w,h); Result := CreateBMP(w,h);
Dest := BmpArray[Result].FData; Dest := BmpArray[Result].FData;
for y := (h-1) downto 0 do for y := (h-1) downto 0 do
for x := (w-1) downto 0 do for x := (w-1) downto 0 do
Dest[y*w+x] := Source[y*w+w-1-x]; Dest[y*w+x] := Source[y*w+w-1-x];
//Can be optmized, this is just proof of concept //Can be optmized, this is just proof of concept
end; end;
function TMBitmaps.CreateBMPFromFile(const Path: string): integer; function TMBitmaps.CreateBMPFromFile(const Path: string): integer;
begin begin
Result := CreateBMP(0,0); Result := CreateBMP(0,0);
BmpArray[result].LoadFromFile(Path); BmpArray[result].LoadFromFile(Path);
end; end;
function HexToInt(HexNum: string): LongInt;inline; function HexToInt(HexNum: string): LongInt;inline;
begin begin
Result:=StrToInt('$' + HexNum); Result:=StrToInt('$' + HexNum);
end; end;
function TMBitmaps.CreateBMPFromString(width, height: integer; Data: string): integer; function TMBitmaps.CreateBMPFromString(width, height: integer; Data: string): integer;
var var
I,II,x,y: LongWord; I,II,x,y: LongWord;
DestLen : LongWord; DestLen : LongWord;
Dest,Source : string; Dest,Source : string;
DestPoint, Point : PByte; DestPoint, Point : PByte;
LazIntf : TLazIntfImage; LazIntf : TLazIntfImage;
begin begin
Result := CreateBMP(width,height); Result := CreateBMP(width,height);
if (Data <> '') and (Length(Data) <> 6) then if (Data <> '') and (Length(Data) <> 6) then
begin; begin;
Point := Pointer(BmpArray[Result].FData); Point := Pointer(BmpArray[Result].FData);
if Data[1] = 'b' then if Data[1] = 'b' then
begin; begin;
Source := Base64DecodeStr(Copy(Data,2,Length(Data) - 1)); Source := Base64DecodeStr(Copy(Data,2,Length(Data) - 1));
Destlen := Width * Height * 3; Destlen := Width * Height * 3;
Setlength(Dest,DestLen); Setlength(Dest,DestLen);
if uncompress(PChar(Dest),Destlen,pchar(Source), Length(Source)) = Z_OK then if uncompress(PChar(Dest),Destlen,pchar(Source), Length(Source)) = Z_OK then
begin; begin;
DestPoint := @Dest[1]; DestPoint := @Dest[1];
i := 0; i := 0;
ii := 2; ii := 2;
Dec(DestLen); Dec(DestLen);
if DestLen > 2 then if DestLen > 2 then
begin; begin;
while (ii < DestLen) do while (ii < DestLen) do
Begin; Begin;
Point[i]:= DestPoint[ii+2]; Point[i]:= DestPoint[ii+2];
Point[i+1]:= DestPoint[ii+1]; Point[i+1]:= DestPoint[ii+1];
Point[i+2]:= DestPoint[ii]; Point[i+2]:= DestPoint[ii];
ii := ii + 3; ii := ii + 3;
i := i + 4; i := i + 4;
end; end;
Point[i] := DestPoint[1]; Point[i] := DestPoint[1];
Point[i+1] := DestPoint[0]; Point[i+1] := DestPoint[0];
Point[i+2] := DestPoint[ii]; Point[i+2] := DestPoint[ii];
end else if (Width = 1) and (Height =1 ) then end else if (Width = 1) and (Height =1 ) then
begin; begin;
Point[0] := DestPoint[1]; Point[0] := DestPoint[1];
Point[1] := DestPoint[0]; Point[1] := DestPoint[0];
Point[2] := DestPoint[2]; Point[2] := DestPoint[2];
end; end;
end; end;
end else if Data[1] = 'z' then end else if Data[1] = 'z' then
begin; begin;
Destlen := Width * Height * 3 *2; Destlen := Width * Height * 3 *2;
Setlength(Dest,DestLen); Setlength(Dest,DestLen);
ii := (Length(Data) - 1) div 2; ii := (Length(Data) - 1) div 2;
SetLength(Source,ii); SetLength(Source,ii);
for i := 1 to ii do for i := 1 to ii do
Source[i] := Chr(HexToInt(Data[i * 2] + Data[i * 2+1])); Source[i] := Chr(HexToInt(Data[i * 2] + Data[i * 2+1]));
if uncompress(PChar(Dest),Destlen,pchar(Source), ii) = Z_OK then if uncompress(PChar(Dest),Destlen,pchar(Source), ii) = Z_OK then
begin; begin;
ii := 1; ii := 1;
i := 0; i := 0;
while (II < DestLen) do while (II < DestLen) do
begin; begin;
Point[i+2]:= HexToInt(Dest[ii] + Dest[ii + 1]); Point[i+2]:= HexToInt(Dest[ii] + Dest[ii + 1]);
Point[i+1]:= HexToInt(Dest[ii+2] + Dest[ii + 3]); Point[i+1]:= HexToInt(Dest[ii+2] + Dest[ii + 3]);
Point[i]:= HexToInt(Dest[ii+4] + Dest[ii + 5]); Point[i]:= HexToInt(Dest[ii+4] + Dest[ii + 5]);
ii := ii + 6; ii := ii + 6;
i := i + 4; i := i + 4;
end; end;
end; end;
end else if LongWord(Length(Data)) = (Width * Height * 3 * 2) then end else if LongWord(Length(Data)) = (Width * Height * 3 * 2) then
begin; begin;
ii := 1; ii := 1;
i := 0; i := 0;
Destlen := Width * Height * 3 * 2; Destlen := Width * Height * 3 * 2;
while (II < DestLen) do while (II < DestLen) do
begin; begin;
Point[i+2]:= HexToInt(Data[ii] + Data[ii + 1]); Point[i+2]:= HexToInt(Data[ii] + Data[ii + 1]);
Point[i+1]:= HexToInt(Data[ii+2] + Data[ii + 3]); Point[i+1]:= HexToInt(Data[ii+2] + Data[ii + 3]);
Point[i]:= HexToInt(Data[ii+4] + Data[ii + 5]); Point[i]:= HexToInt(Data[ii+4] + Data[ii + 5]);
ii := ii + 6; ii := ii + 6;
i := i + 4; i := i + 4;
end; end;
end; end;
end else end else
begin; begin;
{ if Length(data) = 6 then { if Length(data) = 6 then
FastDrawClear(Result,HexToInt(Data)) FastDrawClear(Result,HexToInt(Data))
else else
Bmps[Result].Canvas.Rectangle(0,0,Width-1,Height-1);} Bmps[Result].Canvas.Rectangle(0,0,Width-1,Height-1);}
end; end;
end; end;
procedure TMBitmaps.FreeBMP(Number: integer); procedure TMBitmaps.FreeBMP(Number: integer);
begin begin
if Number = BmpsCurr then if Number = BmpsCurr then
Dec(BmpsCurr) Dec(BmpsCurr)
else else
begin; begin;
inc(FreeSpotsHigh); inc(FreeSpotsHigh);
if FreeSpotsHigh = FreeSpotsLen then if FreeSpotsHigh = FreeSpotsLen then
begin; begin;
inc(FreeSpotsLen); inc(FreeSpotsLen);
SetLength(FreeSpots, FreeSpotsLen); SetLength(FreeSpots, FreeSpotsLen);
end; end;
FreeSpots[FreeSpotsHigh] := Number; FreeSpots[FreeSpotsHigh] := Number;
end; end;
BmpArray[Number].Free; FreeAndNil(BmpArray[Number]);
end; end;
function TMufasaBitmap.SaveToFile(const FileName: string): boolean; function TMufasaBitmap.SaveToFile(const FileName: string): boolean;
var var
rawImage : TRawImage; rawImage : TRawImage;
Bmp : TLazIntfImage; Bmp : TLazIntfImage;
begin begin
ArrDataToRawImage(FData,Point(w,h),RawImage); ArrDataToRawImage(FData,Point(w,h),RawImage);
// Bmp := Graphics.TBitmap.Create; // Bmp := Graphics.TBitmap.Create;
Bmp := TLazIntfImage.Create(RawImage,true); Bmp := TLazIntfImage.Create(RawImage,false);
Bmp.SaveToFile(FileName); Bmp.SaveToFile(FileName);
Bmp.Free; Bmp.Free;
end; end;
procedure TMufasaBitmap.LoadFromFile(const FileName: string); procedure TMufasaBitmap.LoadFromFile(const FileName: string);
var var
LazIntf : TLazIntfImage; LazIntf : TLazIntfImage;
RawImageDesc : TRawImageDescription; RawImageDesc : TRawImageDescription;
begin begin
if FileExists(FileName) then if FileExists(FileName) then
begin; begin;
LazIntf := TLazIntfImage.Create(0,0); LazIntf := TLazIntfImage.Create(0,0);
RawImageDesc.Init_BPP32_B8G8R8_BIO_TTB(LazIntf.Width,LazIntf.Height); RawImageDesc.Init_BPP32_B8G8R8_BIO_TTB(LazIntf.Width,LazIntf.Height);
LazIntf.DataDescription := RawImageDesc; LazIntf.DataDescription := RawImageDesc;
LazIntf.LoadFromFile(FileName); LazIntf.LoadFromFile(FileName);
if Assigned(FData) then if Assigned(FData) then
Freemem(FData); Freemem(FData);
Self.W := LazIntf.Width; Self.W := LazIntf.Width;
Self.H := LazIntf.Height; Self.H := LazIntf.Height;
FData := GetMem(Self.W*Self.H*SizeOf(TRGB32)); FData := GetMem(Self.W*Self.H*SizeOf(TRGB32));
Move(LazIntf.PixelData[0],FData[0],w*h*sizeOf(TRGB32)); Move(LazIntf.PixelData[0],FData[0],w*h*sizeOf(TRGB32));
LazIntf.Free; LazIntf.Free;
end; end;
end; end;
constructor TMBitmaps.Create(Owner: TObject); constructor TMBitmaps.Create(Owner: TObject);
begin begin
inherited Create; inherited Create;
SetLength(BmpArray,50); SetLength(BmpArray,50);
SetLength(FreeSpots, 50); SetLength(FreeSpots, 50);
FreeSpotsLen := 50; FreeSpotsLen := 50;
BmpsHigh := 49; BmpsHigh := 49;
BmpsCurr := -1; BmpsCurr := -1;
FreeSpotsHigh := -1; FreeSpotsHigh := -1;
Self.Client := Owner; Self.Client := Owner;
end; end;
destructor TMBitmaps.Destroy; destructor TMBitmaps.Destroy;
begin var
I : integer;
inherited Destroy; begin
end; for i := 0 to BmpsCurr do
if BmpArray[i] <> nil then
FreeAndNil(BmpArray[i]);
{ TMufasaBitmap } SetLength(BmpArray,0);
function Min(a,b:integer) : integer; SetLength(FreeSpots,0);
begin inherited Destroy;
if a < b then end;
result := a
else
result := b; { TMufasaBitmap }
end; function Min(a,b:integer) : integer;
begin
procedure TMufasaBitmap.SetSize(Awidth, Aheight: integer); if a < b then
var result := a
NewData : PRGB32; else
i,minw,minh : integer; result := b;
begin end;
if (AWidth <> w) or (AHeight <> h) then
begin; procedure TMufasaBitmap.SetSize(Awidth, Aheight: integer);
if AWidth*AHeight <> 0 then var
begin; NewData : PRGB32;
NewData := GetMem(AWidth * AHeight * SizeOf(TRGB32)); i,minw,minh : integer;
FillDWord(NewData[0],AWidth*AHeight,0); begin
end if (AWidth <> w) or (AHeight <> h) then
else begin;
NewData := nil; if AWidth*AHeight <> 0 then
if Assigned(FData) and Assigned(NewData) and (w*H <> 0) then begin;
begin; NewData := GetMem(AWidth * AHeight * SizeOf(TRGB32));
minw := Min(AWidth,w); FillDWord(NewData[0],AWidth*AHeight,0);
minh := Min(AHeight,h); end
for i := 0 to minh - 1 do else
Move(FData[i*w],Newdata[i*AWidth],minw * SizeOf(TRGB32)); NewData := nil;
end; if Assigned(FData) and Assigned(NewData) and (w*H <> 0) then
if Assigned(FData) then begin;
FreeMem(FData); minw := Min(AWidth,w);
FData := NewData; minh := Min(AHeight,h);
w := AWidth; for i := 0 to minh - 1 do
h := AHeight; Move(FData[i*w],Newdata[i*AWidth],minw * SizeOf(TRGB32));
end; end;
end; if Assigned(FData) then
FreeMem(FData);
constructor TMufasaBitmap.Create; FData := NewData;
begin w := AWidth;
inherited Create; h := AHeight;
FData:= nil; end;
w := 0; end;
h := 0;
end; constructor TMufasaBitmap.Create;
begin
destructor TMufasaBitmap.Destroy; inherited Create;
begin FData:= nil;
if Assigned(FData) then w := 0;
Freemem(FData,w*h*SizeOf(TRGB32)); h := 0;
inherited Destroy; end;
end;
destructor TMufasaBitmap.Destroy;
end. begin
if Assigned(FData) then
Freemem(FData);
inherited Destroy;
end;
end.