moparisthebest
/
Simba
mirror of https://github.com/moparisthebest/Simba
1
0
Fork 0
Code Issues Releases Wiki Activity

Updated Bitmaps! 

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@49 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-09-13 07:25:40 +00:00
parent dee2b98fd9
commit 1797201d2a
5 changed files with 224 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
Units/MMLAddon/PSInc/Wrappers/bitmap.inc
View File

@ -42,3 +42,48 @@ function CreateMirroredBitmap(Bmp : integer) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp);
end;
function FastGetPixel(bmp,x,y : integer) : LongWord;
begin;
Result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixel(x,y);
end;
function FastGetPixels(bmp : integer; TPA : TPointArray) : TIntegerArray;
begin;
result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixels(TPA);
end;
procedure FastSetPixel(Bmp,x,y : integer; Color : TColor);
begin
CurrThread.Client.MBitmaps.Bmp[bmp].FastSetPixel(x,y,color);
end;
procedure FastSetPixels(Bmp : integer; TPA : TPointArray; Colors : TIntegerArray);
begin;
CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors);
end;
procedure FastDrawClear(bmp : integer; Color : TColor);
begin;
CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color);
end;
procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);
begin;
CurrThread.Client.MBitmaps.Bmp[SourceBitmap].FastDrawTransparent(x,y,CurrThread.Client.MBitmaps.Bmp[TargetBitmap]);
end;
procedure SetTransparentColor(Bmp : integer; Color : TColor);
begin
CurrThread.Client.MBitmaps.Bmp[Bmp].SetTransparentColor(Color);
end;
function GetTransparentColor(Bmp : integer) : TColor;
begin;
Result := CurrThread.Client.MBitmaps.Bmp[bmp].GetTransparentColor;
end;
procedure FastReplaceColor(bmp: Integer; OldColor, NewColor: TColor);
begin
CurrThread.Client.MBitmaps.Bmp[Bmp].FastReplaceColor(OldColor,NewColor);
end;

18
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -1,3 +1,6 @@
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
@ -10,4 +13,19 @@ Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');

4
Units/MMLAddon/mmlpsthread.pas
View File

@ -47,7 +47,7 @@ uses
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
uPSR_extctrls, //Runtime-libs
Graphics, //For Graphics types
lclintf; // for GetTickCount and others.
@ -111,6 +111,7 @@ begin
// Set some defines
{$I PSInc/psdefines.inc}
FreeOnTerminate := True;
Self.OnTerminate := @Self.OnThreadTerminate;
inherited Create(CreateSuspended);
@ -130,7 +131,6 @@ end;
// include PS wrappers
{$I PSInc/Wrappers/bitmap.inc}
{$I PSInc/Wrappers/colour.inc}

171
Units/MMLCore/bitmaps.pas
View File

@ -13,13 +13,26 @@ type
TMufasaBitmap = class(TObject)
private
w,h : integer;
TransparentColor : TRGB32;
TransparentSet : boolean;
public
FData : PRGB32;
Index : integer;
procedure SetSize(AWidth,AHeight : integer);
property Width : Integer read w;
property Height : Integer read h;
procedure ValidatePoint(x,y : integer);
function SaveToFile(const FileName : string) :boolean;
procedure LoadFromFile(const FileName : string);
procedure FastSetPixel(x,y : integer; Color : TColor);
procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);
function FastGetPixel(x,y : integer) : TColor;
function FastGetPixels(TPA : TPointArray) : TIntegerArray;
Procedure SetTransparentColor(Col : TColor);
Function GetTransparentColor : TColor;
procedure FastDrawClear(Color : TColor);
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
procedure FastReplaceColor(OldColor, NewColor: TColor);
constructor Create;
destructor Destroy;override;
end;
@ -49,14 +62,26 @@ implementation
uses
Windowutil,paszlib,DCPbase64;
function Min(a,b:integer) : integer;
begin
if a < b then
result := a
else
result := b;
end;
{ TMBitmaps }
function TMBitmaps.GetBMP(Index: integer): TMufasaBitmap;
begin
Result := nil;
if (Index >= 0) and (Index <= BmpsCurr) then
if BmpArray[Index] <> nil then
Result := BmpArray[Index];
if Result = nil then
raise Exception.CreateFmt('The bitmap[%d] does not exist',[Index]);
end;
function TMBitmaps.CreateBMP(w,h : integer): Integer;
@ -78,6 +103,7 @@ begin
end;
BmpArray[Result] := TMufasaBitmap.Create;
BmpArray[Result].SetSize(w,h);
BmpArray[Result].Index:= Result;
end;
function TMBitmaps.CreateMirroredBitmap(bitmap: Integer): Integer;
@ -189,15 +215,18 @@ begin
end;
end else
begin;
{ if Length(data) = 6 then
FastDrawClear(Result,HexToInt(Data))
else
Bmps[Result].Canvas.Rectangle(0,0,Width-1,Height-1);}
if Length(data) = 6 then
BmpArray[Result].FastDrawClear(HexToInt(Data));
// else
// FastDrawClear(Result,clBlack);
end;
end;
procedure TMBitmaps.FreeBMP(Number: integer);
var
ToDestroy : TMufasaBitmap;
begin
ToDestroy := GetBMP(Number);
if Number = BmpsCurr then
Dec(BmpsCurr)
else
@ -210,7 +239,7 @@ begin
end;
FreeSpots[FreeSpotsHigh] := Number;
end;
FreeAndNil(BmpArray[Number]);
FreeAndNil(ToDestroy);
end;
function TMufasaBitmap.SaveToFile(const FileName: string): boolean;
@ -246,6 +275,123 @@ begin
end;
end;
function RGBToBGR(Color : TColor) : TRGB32; inline;
begin;
Result.R := Color and $ff;
Result.G := Color shr 8 and $ff;
Result.B := Color shr 16 and $ff;
end;
function BGRToRGB(BGR : TRGB32) : TColor;inline;
begin;
Result := BGR.R or BGR.g shl 8 or BGR.b shl 16;
end;
procedure TMufasaBitmap.FastSetPixel(x, y: integer; Color: TColor);
begin
ValidatePoint(x,y);
FData[y*w+x] := RGBToBGR(Color);
end;
procedure TMufasaBitmap.FastSetPixels(TPA: TPointArray; Colors: TIntegerArray);
var
i,len : integer;
begin
len := High(TPA);
if Len <> High(colors) then
Raise Exception.CreateFMT('TPA/Colors Length differ',[]);
for i := 0 to len do
begin;
ValidatePoint(TPA[i].x,TPA[i].y);
FData[TPA[i].y * w + TPA[i].x] := RGBToBGR(Colors[i]);
end;
end;
function TMufasaBitmap.FastGetPixel(x, y: integer): TColor;
begin
ValidatePoint(x,y);
Result := BGRToRGB(FData[y*w+x]);
end;
function TMufasaBitmap.FastGetPixels(TPA: TPointArray): TIntegerArray;
var
i,len : integer;
begin
len := high(TPA);
SetLength(result,len+1);
for i := 0 to len do
begin;
ValidatePoint(TPA[i].x,TPA[i].y);
Result[i] := BGRToRGB(FData[TPA[i].y*w + TPA[i].x]);
end;
end;
procedure TMufasaBitmap.SetTransparentColor(Col: TColor);
begin
TransparentColor:= RGBToBGR(Col);
TransparentSet:= True;
end;
function TMufasaBitmap.GetTransparentColor: TColor;
begin
if TransparentSet then
Result := BGRToRGB(TransparentColor)
else
raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]);
end;
procedure TMufasaBitmap.FastDrawClear(Color: TColor);
var
i : integer;
Rec : TRGB32;
begin
Rec := RGBToBGR(Color);
if h > 0 then
begin;
for i := (w-1) downto 0 do
FData[i] := Rec;
for i := (h-1) downto 1 do
Move(FData[0],FData[i*w],w*SizeOf(TRGB32));
end;
end;
procedure TMufasaBitmap.FastDrawTransparent(x, y: Integer;
TargetBitmap: TMufasaBitmap);
var
MinW,MinH,TargetW,TargetH : Integer;
loopx,loopy : integer;
begin
ValidatePoint(x,y);
TargetW := TargetBitmap.Width;
TargetH := TargetBitmap.height;
MinW := Min(w-1,TargetW-x-1);
MinH := Min(h-1,TargetH-y-1);
if TransparentSet then
begin;
for loopy := 0 to MinH do
for loopx := 0 to MinW do
if LongWord(FData[loopy * w + loopx]) <> LongWord(TransparentColor) then
TargetBitmap.FData[(loopy + y) * TargetW + loopx + x] := FData[Loopy * w + loopx];
end
else
for loopy := 0 to MinH do
Move(FData[loopy*w],TargetBitmap.FData[(loopy+y) * TargetW + x],(MinW+1) * SizeOf(TRGB32));
end;
procedure TMufasaBitmap.FastReplaceColor(OldColor, NewColor: TColor);
var
OldCol,NewCol : TRGB32;
i : integer;
begin
OldCol := RGBToBGR(OldColor);
NewCol := RGBToBGR(NewColor);
for i := w*h-1 downto 0 do
if LongWord(FData[i]) = LongWord(OldCol) then
FData[i] := NewCol;
end;
constructor TMBitmaps.Create(Owner: TObject);
begin
inherited Create;
@ -272,14 +418,6 @@ end;
{ TMufasaBitmap }
function Min(a,b:integer) : integer;
begin
if a < b then
result := a
else
result := b;
end;
procedure TMufasaBitmap.SetSize(Awidth, Aheight: integer);
var
NewData : PRGB32;
@ -309,10 +447,17 @@ begin
end;
end;
procedure TMufasaBitmap.ValidatePoint(x, y: integer);
begin
if (x <0) or (x >= w) or (y < 0) or (y >= h) then
raise Exception.CreateFmt('You are accesing an invalid point, (%d,%d) at bitmap[%d]',[x,y,index]);
end;
constructor TMufasaBitmap.Create;
begin
inherited Create;
FData:= nil;
TransparentSet:= False;
w := 0;
h := 0;
end;

1
Units/MMLCore/mufasatypes.pas
View File

@ -24,6 +24,7 @@ type
TMousePress = (mouse_Down, mouse_Up);
TPointArray = array of TPoint;
TVariantArray = Array of Variant;
TIntegerArray = Array of Integer;
implementation