From 33b416a93959aea308c446f964099f591e5f6af7 Mon Sep 17 00:00:00 2001 From: Raymond Date: Sat, 3 Oct 2009 19:38:40 +0000 Subject: [PATCH] Fixed. git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@99 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Units/MMLAddon/PSInc/pscompile.inc | 134 +++--- Units/MMLCore/client.pas | 2 +- Units/MMLCore/dtm.pas | 644 ++++++++++++++--------------- 3 files changed, 390 insertions(+), 390 deletions(-) diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index e076466..77070a2 100644 --- a/Units/MMLAddon/PSInc/pscompile.inc +++ b/Units/MMLAddon/PSInc/pscompile.inc @@ -1,67 +1,67 @@ - -Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer'); -Sender.Comp.AddTypeS('TPointArray','Array of TPoint'); -Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)'); - -//Sender.Comp.AddTypeS('pDTM','pDTM = record p: TPointArray; c, t, asz, ash: TIntegerArray; end'); - -Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); -Sender.AddFunction(@psWriteln,'procedure writeln(s : string);'); - -{ DTM } - -Sender.AddFunction(@ps_StringFromDTM, 'function StringFromDTM(DTMString: String): Integer;'); -Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);'); -Sender.AddFunction(@FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;'); - - -{maths} -sender.AddFunction(@power,'function pow(base,exponent : extended) : extended'); -Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;'); -Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;'); -Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;'); - -Sender.AddFunction(@Freeze, 'function freeze:boolean;'); -Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;'); - -Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;'); -Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); -Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;'); -Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;'); -Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean'); -Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;'); -Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;'); - -Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);'); -Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);'); - -Sender.AddFunction(@Wait, 'procedure wait(t: integer);'); -Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);'); -Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);'); -Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;'); - -Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;'); -Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);'); -Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);'); -Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;'); -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(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : 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);'); - - - - - - - + +Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer'); +Sender.Comp.AddTypeS('TPointArray','Array of TPoint'); +Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)'); + +//Sender.Comp.AddTypeS('pDTM','pDTM = record p: TPointArray; c, t, asz, ash: TIntegerArray; end'); + +Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); +Sender.AddFunction(@psWriteln,'procedure writeln(s : string);'); + +{ DTM } + +Sender.AddFunction(@ps_StringFromDTM, 'function DTMFromString(DTMString: String): Integer;'); +Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);'); +Sender.AddFunction(@FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;'); + + +{maths} +sender.AddFunction(@power,'function pow(base,exponent : extended) : extended'); +Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;'); +Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;'); +Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;'); + +Sender.AddFunction(@Freeze, 'function freeze:boolean;'); +Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;'); + +Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;'); +Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); +Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;'); +Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;'); +Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean'); +Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;'); +Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;'); + +Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);'); +Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);'); + +Sender.AddFunction(@Wait, 'procedure wait(t: integer);'); +Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);'); +Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);'); +Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;'); + +Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;'); +Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);'); +Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);'); +Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;'); +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(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : 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/MMLCore/client.pas b/Units/MMLCore/client.pas index aa3ba0a..f7b8e82 100644 --- a/Units/MMLCore/client.pas +++ b/Units/MMLCore/client.pas @@ -34,7 +34,7 @@ begin MFiles := TMFiles.Create; MFinder := TMFinder.Create(Self); MBitmaps := TMBitmaps.Create(self); - MDTM := MDTM.Create(self); + MDTM := TMDTM.Create(self); end; destructor TClient.Destroy; diff --git a/Units/MMLCore/dtm.pas b/Units/MMLCore/dtm.pas index 9b8e8c7..b56fac3 100644 --- a/Units/MMLCore/dtm.pas +++ b/Units/MMLCore/dtm.pas @@ -1,322 +1,322 @@ -unit dtm; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, MufasaTypes; - -type - TMDTM = class(TObject) - constructor Create(Owner: TObject); - destructor Destroy; override; - - function AddDTM(d: TDTM): Integer; - function AddpDTM(d: pDTM): Integer; - function GetDTM(index: Integer; var dtm: pDTM): Boolean; - procedure FreeDTM(DTM: Integer); - Function StringToDTM(S: String): pDTM; - - function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, - y2: Integer): Boolean; - { function FindDTMs(DTM: Integer; var Points: TPointArray; x1, y1, x2, - y2: Integer): Boolean; - function FindDTMRotated(DTM: Integer; var x, y: Integer; x1, y1, x2, - y2: Integer; sAngle, eAngle, aStep: Extended; - var aFound: Extended): Boolean; - function FindDTMsRotated(DTM: Integer; var Points: TPointArray; x1, - y1, x2, y2: Integer; sAngle, eAngle, - aStep: Extended; var aFound: T2DExtendedArray) - : Boolean; } - function pFindDTM(DTM: pDTM; var x, y: Integer; x1, y1, x2, y2: - Integer): Boolean; - - private - - Client: TObject; - - // For decompressing. - BufferString: String; - - DTMList: Array Of pDTM; - FreeSpots: Array Of Integer; - end; -const - dtm_Rectangle = 0; - dtm_Cross = 1; - dtm_DiagonalCross = 2; - dtm_Circle = 3; - dtm_Triangle = 4; - -{ - I am not sure wether I should simply copy and paste the old DTM implementation, - or rewrite it from scratch. - - I recall there was something partially wrong with SCAR-alike DTM conversions - to Mufasa DTM's... - - The old DTM system problaby doesn't perform that well, but seems to be quite - stable and complete. - - If I would rewrite it from scratch, it would probably be faster, and - hopefully more efficient.That won't be too hard, especially since I have - direct data access now. (TClient FTW!) - - Rewrite from scratch it will be, I guess. - And AreaShape will be turned into a {$I }, inline simply doesn't cut it. - - ~Wizz -} - - -implementation -uses - Client, dtmutil, paszlib; - -type - TBufferByteArray = Array[0..524288] of Byte; - PBufferByteArray = ^TBufferByteArray; - -constructor TMDTM.Create(Owner: TObject); -begin - inherited Create; - Self.Client := Owner; - - SetLength(DTMList, 0); - SetLength(FreeSpots, 0); - SetLength(BufferString, 524288); -end; - -destructor TMDTM.Destroy; - -begin - SetLength(DTMList, 0); - SetLength(FreeSpots, 0); - SetLength(BufferString, 0); - - inherited Destroy; -end; - -function HexToInt(HexNum: string): LongInt;inline; -begin - Result:=StrToInt('$' + HexNum); -end; - -function TMDTM.StringToDTM(S: String): pDTM; -var - b: PBufferByteArray; - Source : String; - DestLen : LongWord; - i,ii,c : integer; -begin - SetLength(Result.p,0); - SetLength(Result.c,0); - SetLength(Result.t,0); - SetLength(Result.asz,0); - SetLength(Result.ash,0); - ii := Length(S); - if (ii = 0) or (ii mod 2 <> 0) then - Exit; - ii := ii div 2; - SetLength(Source,ii); - for i := 1 to ii do - Source[i] := Chr(HexToInt(S[i * 2 - 1] + S[i * 2])); - DestLen := Length(Self.BufferString); - if uncompress(PChar(Self.Bufferstring),Destlen,pchar(Source), ii) = Z_OK then - begin; - if (Destlen mod 36) > 0 then - begin; - Writeln('Invalid DTM'); - Exit; - end; - DestLen := DestLen div 36; - SetLength(Result.p,DestLen); - SetLength(Result.c,DestLen); - SetLength(Result.t,DestLen); - SetLength(Result.asz,DestLen); - SetLength(Result.ash,DestLen); - b := @Self.Bufferstring[1]; - for i := 0 to DestLen - 1 do - begin; - c := i * 36; - Result.p[i].x := PInteger(@b^[c+1])^; - Result.p[i].y := PInteger(@b^[c+5])^; - Result.asz[i] := PInteger(@b^[c+12])^; - Result.ash[i] := PInteger(@b^[c+16])^; - Result.c[i] := PInteger(@b^[c+20])^; - Result.t[i] := PInteger(@b^[c+24])^; - end; - end; -end; - -function TMDTM.AddDTM(d: TDTM): Integer; - -begin - if Length(FreeSpots) > 0 then - begin - DTMList[FreeSpots[High(FreeSpots)]] := TDTMTopDTM(d); - Result := FreeSpots[High(FreeSpots)]; - SetLength(FreeSpots, High(FreeSpots)); - end - else - begin - SetLength(DTMList, Length(DTMList) + 1); - DTMList[High(DTMList)] := TDTMTopDTM(d); - Result := High(DTMList); - end; -end; - -{/\ - Adds the given pDTM to the DTM Array, and returns it's index. -/\} - -function TMDTM.AddpDTM(d: pDTM): Integer; - -begin - if Length(FreeSpots) > 0 then - begin - DTMList[FreeSpots[High(FreeSpots)]] := d; - Result := FreeSpots[High(FreeSpots)]; - SetLength(FreeSpots, High(FreeSpots)); - end - Else - begin - SetLength(DTMList, Length(DTMList) + 1); - DTMList[High(DTMList)] := d; - Result := High(DTMList); - end; -end; - -{/\ - Returns the DTM (pDTM type) in the variable dtm at the given index. - Returns true is succesfull, false if the dtm does not exist. -/\} - -function TMDTM.GetDTM(index: Integer; var dtm: pDTM): Boolean; -begin - Result := True; - try - dtm := DTMList[index]; - except - begin - raise Exception.CreateFmt('The given DTM Index ([%d]) is invalid.', - [index]); - //WriteLn('DTM Index ' + IntToStr(index) + ' does not exist'); - Result := False; - end; - end -end; - -{/\ - Unloads the DTM at the given index from the DTM Array. - Notes: - Will keep track of not used index, so it is very memory efficient. -/\} - -Procedure TMDTM.FreeDTM(DTM: Integer); -begin - try - SetLength(DTMList[DTM].p, 0); - SetLength(DTMList[DTM].c, 0); - SetLength(DTMList[DTM].t, 0); - SetLength(DTMList[DTM].asz, 0); - SetLength(DTMList[DTM].ash, 0); - except - //WriteLn('Invalid DTM'); - end; - SetLength(FreeSpots, Length(FreeSpots) + 1); - FreeSpots[High(FreeSpots)] := DTM; -end; - -{ - Tries to find the given DTM (index). If found will put the point the dtm has - been found at in x, y and result to true. -} -function TMDTM.FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean; -var - temp: pDTM; -begin - if GetDTM(DTM, temp) then - Result := pFindDTM(temp, x, y, x1, y1, x2, y2) - else - begin - x := 0; - y := 0; - Result := False; - end; -end; - -{ - Tries to find the given pDTM. If found will put the point the dtm has - been found at in x, y and result to true. -} - -function TMDTM.pFindDTM(DTM: pDTM; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean; - -var - mP: TPointArray; - I, J, H, dH: Integer; - Found: Boolean; - TempTP: TPoint; - RetData: TRetData; - -begin - for I := 1 to High(DTM.p) do - begin - DTM.p[I].x := DTM.p[I].x - DTM.p[0].x; - DTM.p[I].y := DTM.p[I].y - DTM.p[0].y; - end; - - // X2 := X2 - MaxSubPointDist.X - // Y2 := Y2 - MaxSubPointDist.Y - // X1 := X1 + MaxSubPointDist.X - // Y1 := Y1 + MaxSubPointDist.Y - // If X2 > X1 then Exit - // If Y2 > Y1 then Exit - // Will make sure there are no out of bounds exceptions, and will make it faster - - TClient(Client).MWindow.Freeze(); - - TClient(Client).MFinder.FindColorsTolerance(mP, DTM.c[Low(DTM.c)], - x1, y1, x2, y2, DTM.t[Low(DTM.t)]); - - TClient(Client).MWindow.GetDimensions(H, dH); - RetData := TClient(Client).MWindow.ReturnData(0, 0, H, dH); - - H := High(mP); - dH := High(DTM.p); - for I := 0 to H do - begin - // Use MainPoint's AreaSize and Shape. - // for Loop on mP, depending on the AreaShape. then on all the code beneath - // this point, use the var that is retrieved from the for loop. - Found := True; - for J := 1 to dH do - begin - TempTP.X := DTM.p[J].X + mP[I].X; - TempTP.Y := DTM.p[J].Y + mP[I].Y; - //Now would be the time to Rotate TempTP - //If Not AreaShape(DTM.c[J], DTM.t[J], DTM.asz[J], DTM.ash[J], TempTP) then - if False then - begin - Found := False; - Break; - end; - end; - - if Found then - begin - Result := True; - x := mP[I].X; - y := mP[I].Y; - TClient(Client).MWindow.UnFreeze(); - Exit; - end; - end; - TClient(Client).MWindow.UnFreeze(); - Result := False; -end; - -end. - +unit dtm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, MufasaTypes; + +type + TMDTM = class(TObject) + + function AddDTM(d: TDTM): Integer; + function AddpDTM(d: pDTM): Integer; + function GetDTM(index: Integer; var dtm: pDTM): Boolean; + procedure FreeDTM(DTM: Integer); + Function StringToDTM(S: String): pDTM; + + function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, + y2: Integer): Boolean; + { function FindDTMs(DTM: Integer; var Points: TPointArray; x1, y1, x2, + y2: Integer): Boolean; + function FindDTMRotated(DTM: Integer; var x, y: Integer; x1, y1, x2, + y2: Integer; sAngle, eAngle, aStep: Extended; + var aFound: Extended): Boolean; + function FindDTMsRotated(DTM: Integer; var Points: TPointArray; x1, + y1, x2, y2: Integer; sAngle, eAngle, + aStep: Extended; var aFound: T2DExtendedArray) + : Boolean; } + function pFindDTM(DTM: pDTM; var x, y: Integer; x1, y1, x2, y2: + Integer): Boolean; + + constructor Create(Owner: TObject); + destructor Destroy; override; + private + + Client: TObject; + + // For decompressing. + BufferString: String; + + DTMList: Array Of pDTM; + FreeSpots: Array Of Integer; + end; +const + dtm_Rectangle = 0; + dtm_Cross = 1; + dtm_DiagonalCross = 2; + dtm_Circle = 3; + dtm_Triangle = 4; + +{ + I am not sure wether I should simply copy and paste the old DTM implementation, + or rewrite it from scratch. + + I recall there was something partially wrong with SCAR-alike DTM conversions + to Mufasa DTM's... + + The old DTM system problaby doesn't perform that well, but seems to be quite + stable and complete. + + If I would rewrite it from scratch, it would probably be faster, and + hopefully more efficient.That won't be too hard, especially since I have + direct data access now. (TClient FTW!) + + Rewrite from scratch it will be, I guess. + And AreaShape will be turned into a {$I }, inline simply doesn't cut it. + + ~Wizz +} + + +implementation +uses + Client, dtmutil, paszlib; + +type + TBufferByteArray = Array[0..524287] of Byte; + PBufferByteArray = ^TBufferByteArray; + +constructor TMDTM.Create(Owner: TObject); +begin + inherited Create; + Self.Client := Owner; + + SetLength(DTMList, 0); + SetLength(FreeSpots, 0); + SetLength(BufferString, 524288); +end; + +destructor TMDTM.Destroy; + +begin + SetLength(DTMList, 0); + SetLength(FreeSpots, 0); + SetLength(BufferString, 0); + + inherited Destroy; +end; + +function HexToInt(HexNum: string): LongInt;inline; +begin + Result:=StrToInt('$' + HexNum); +end; + +function TMDTM.StringToDTM(S: String): pDTM; +var + b: PBufferByteArray; + Source : String; + DestLen : longword; + i,ii,c : integer; +begin + SetLength(Result.p,0); + SetLength(Result.c,0); + SetLength(Result.t,0); + SetLength(Result.asz,0); + SetLength(Result.ash,0); + ii := Length(S); + if (ii = 0) or (ii mod 2 <> 0) then + Exit; + ii := ii div 2; + SetLength(Source,ii); + for i := 1 to ii do + Source[i] := Chr(HexToInt(S[i * 2 - 1] + S[i * 2])); + DestLen := Length(Self.BufferString); + if uncompress(PChar(Self.Bufferstring),Destlen,pchar(Source), ii) = Z_OK then + begin; + if (Destlen mod 36) > 0 then + begin; + Writeln('Invalid DTM'); + Exit; + end; + DestLen := DestLen div 36; + SetLength(Result.p,DestLen); + SetLength(Result.c,DestLen); + SetLength(Result.t,DestLen); + SetLength(Result.asz,DestLen); + SetLength(Result.ash,DestLen); + b := @Self.Bufferstring[1]; + for i := 0 to DestLen - 1 do + begin; + c := i * 36; + Result.p[i].x := PInteger(@b^[c+1])^; + Result.p[i].y := PInteger(@b^[c+5])^; + Result.asz[i] := PInteger(@b^[c+12])^; + Result.ash[i] := PInteger(@b^[c+16])^; + Result.c[i] := PInteger(@b^[c+20])^; + Result.t[i] := PInteger(@b^[c+24])^; + end; + end; +end; + +function TMDTM.AddDTM(d: TDTM): Integer; + +begin + if Length(FreeSpots) > 0 then + begin + DTMList[FreeSpots[High(FreeSpots)]] := TDTMTopDTM(d); + Result := FreeSpots[High(FreeSpots)]; + SetLength(FreeSpots, High(FreeSpots)); + end + else + begin + SetLength(DTMList, Length(DTMList) + 1); + DTMList[High(DTMList)] := TDTMTopDTM(d); + Result := High(DTMList); + end; +end; + +{/\ + Adds the given pDTM to the DTM Array, and returns it's index. +/\} + +function TMDTM.AddpDTM(d: pDTM): Integer; + +begin + if Length(FreeSpots) > 0 then + begin + DTMList[FreeSpots[High(FreeSpots)]] := d; + Result := FreeSpots[High(FreeSpots)]; + SetLength(FreeSpots, High(FreeSpots)); + end + Else + begin + SetLength(DTMList, Length(DTMList) + 1); + DTMList[High(DTMList)] := d; + Result := High(DTMList); + end; +end; + +{/\ + Returns the DTM (pDTM type) in the variable dtm at the given index. + Returns true is succesfull, false if the dtm does not exist. +/\} + +function TMDTM.GetDTM(index: Integer; var dtm: pDTM): Boolean; +begin + Result := True; + try + dtm := DTMList[index]; + except + begin + raise Exception.CreateFmt('The given DTM Index ([%d]) is invalid.', + [index]); + //WriteLn('DTM Index ' + IntToStr(index) + ' does not exist'); + Result := False; + end; + end +end; + +{/\ + Unloads the DTM at the given index from the DTM Array. + Notes: + Will keep track of not used index, so it is very memory efficient. +/\} + +Procedure TMDTM.FreeDTM(DTM: Integer); +begin + try + SetLength(DTMList[DTM].p, 0); + SetLength(DTMList[DTM].c, 0); + SetLength(DTMList[DTM].t, 0); + SetLength(DTMList[DTM].asz, 0); + SetLength(DTMList[DTM].ash, 0); + except + //WriteLn('Invalid DTM'); + end; + SetLength(FreeSpots, Length(FreeSpots) + 1); + FreeSpots[High(FreeSpots)] := DTM; +end; + +{ + Tries to find the given DTM (index). If found will put the point the dtm has + been found at in x, y and result to true. +} +function TMDTM.FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean; +var + temp: pDTM; +begin + if GetDTM(DTM, temp) then + Result := pFindDTM(temp, x, y, x1, y1, x2, y2) + else + begin + x := 0; + y := 0; + Result := False; + end; +end; + +{ + Tries to find the given pDTM. If found will put the point the dtm has + been found at in x, y and result to true. +} + +function TMDTM.pFindDTM(DTM: pDTM; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean; + +var + mP: TPointArray; + I, J, H, dH: Integer; + Found: Boolean; + TempTP: TPoint; + RetData: TRetData; + +begin + for I := 1 to High(DTM.p) do + begin + DTM.p[I].x := DTM.p[I].x - DTM.p[0].x; + DTM.p[I].y := DTM.p[I].y - DTM.p[0].y; + end; + + // X2 := X2 - MaxSubPointDist.X + // Y2 := Y2 - MaxSubPointDist.Y + // X1 := X1 + MaxSubPointDist.X + // Y1 := Y1 + MaxSubPointDist.Y + // If X2 > X1 then Exit + // If Y2 > Y1 then Exit + // Will make sure there are no out of bounds exceptions, and will make it faster + + TClient(Client).MWindow.Freeze(); + + TClient(Client).MFinder.FindColorsTolerance(mP, DTM.c[Low(DTM.c)], + x1, y1, x2, y2, DTM.t[Low(DTM.t)]); + + TClient(Client).MWindow.GetDimensions(H, dH); + RetData := TClient(Client).MWindow.ReturnData(0, 0, H, dH); + + H := High(mP); + dH := High(DTM.p); + for I := 0 to H do + begin + // Use MainPoint's AreaSize and Shape. + // for Loop on mP, depending on the AreaShape. then on all the code beneath + // this point, use the var that is retrieved from the for loop. + Found := True; + for J := 1 to dH do + begin + TempTP.X := DTM.p[J].X + mP[I].X; + TempTP.Y := DTM.p[J].Y + mP[I].Y; + //Now would be the time to Rotate TempTP + //If Not AreaShape(DTM.c[J], DTM.t[J], DTM.asz[J], DTM.ash[J], TempTP) then + if False then + begin + Found := False; + Break; + end; + end; + + if Found then + begin + Result := True; + x := mP[I].X; + y := mP[I].Y; + TClient(Client).MWindow.UnFreeze(); + Exit; + end; + end; + TClient(Client).MWindow.UnFreeze(); + Result := False; +end; + +end. +