diff --git a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc index 3e0c034..bfdc018 100644 --- a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc +++ b/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; diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index 5651280..ad14a21 100644 --- a/Units/MMLAddon/PSInc/pscompile.inc +++ b/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);'); + + + + + + diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index fc2ad8c..4ca1ec8 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/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} diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 3ae98c8..19b7e86 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/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 - 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; diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 681f136..09b6647 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/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