Updated Bitmaps!

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@49 3f818213-9676-44b0-a9b4-5e4c4e03d09d

Units/MMLAddon/PSInc/Wrappers/bitmap.inc

@@ -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;

Units/MMLAddon/PSInc/pscompile.inc

@@ -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);');
+
+
+
+
+
+
 

Units/MMLAddon/mmlpsthread.pas

@@ -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}
 
 

Units/MMLCore/bitmaps.pas

@@ -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
+    if Length(data) = 6 then
-      FastDrawClear(Result,HexToInt(Data))
+      BmpArray[Result].FastDrawClear(HexToInt(Data));
-    else
+//    else
-      Bmps[Result].Canvas.Rectangle(0,0,Width-1,Height-1);}
+//      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;

Units/MMLCore/mufasatypes.pas

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