From 490c3e18713f47c1a02f696cab316ad5dba5104d Mon Sep 17 00:00:00 2001 From: Wizzup? Date: Sat, 3 Oct 2009 22:11:30 +0000 Subject: [PATCH] Fixed some warnings + added FindDTM and AreaShape. git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@100 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Projects/SAMufasaGUI/project1.lpi | 251 +++++---- Units/MMLAddon/PSInc/Wrappers/dtm.inc | 2 +- Units/MMLAddon/PSInc/pscompile.inc | 134 ++--- Units/MMLAddon/colourpicker.pas | 3 +- Units/MMLAddon/mmlpsthread.pas | 10 +- Units/MMLAddon/mmlthread.pas | 3 +- Units/MMLCore/dtm.pas | 770 +++++++++++++++----------- 7 files changed, 655 insertions(+), 518 deletions(-) diff --git a/Projects/SAMufasaGUI/project1.lpi b/Projects/SAMufasaGUI/project1.lpi index 60f1a3f..49bfaef 100644 --- a/Projects/SAMufasaGUI/project1.lpi +++ b/Projects/SAMufasaGUI/project1.lpi @@ -7,7 +7,7 @@ <UseXPManifest Value="True"/> - <ActiveEditorIndexAtStart Value="3"/> + <ActiveEditorIndexAtStart Value="10"/> </General> <VersionInfo> <ProjectVersion Value=""/> @@ -33,7 +33,7 @@ <PackageName Value="LCL"/> </Item2> </RequiredPackages> - <Units Count="128"> + <Units Count="129"> <Unit0> <Filename Value="project1.lpr"/> <IsPartOfProject Value="True"/> @@ -41,7 +41,7 @@ <CursorPos X="26" Y="12"/> <TopLine Value="1"/> <EditorIndex Value="0"/> - <UsageCount Value="153"/> + <UsageCount Value="157"/> <Loaded Value="True"/> </Unit0> <Unit1> @@ -170,10 +170,10 @@ <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="TestUnit"/> - <CursorPos X="37" Y="115"/> - <TopLine Value="84"/> - <EditorIndex Value="11"/> - <UsageCount Value="119"/> + <CursorPos X="10" Y="11"/> + <TopLine Value="1"/> + <EditorIndex Value="14"/> + <UsageCount Value="123"/> <Loaded Value="True"/> </Unit18> <Unit19> @@ -302,20 +302,20 @@ <Filename Value="../../Units/MMLCore/client.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="Client"/> - <CursorPos X="23" Y="18"/> - <TopLine Value="18"/> + <CursorPos X="39" Y="8"/> + <TopLine Value="1"/> <EditorIndex Value="2"/> - <UsageCount Value="118"/> + <UsageCount Value="122"/> <Loaded Value="True"/> </Unit37> <Unit38> <Filename Value="../../Units/MMLCore/mufasatypes.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="MufasaTypes"/> - <CursorPos X="1" Y="35"/> - <TopLine Value="21"/> + <CursorPos X="21" Y="36"/> + <TopLine Value="30"/> <EditorIndex Value="1"/> - <UsageCount Value="118"/> + <UsageCount Value="122"/> <Loaded Value="True"/> </Unit38> <Unit39> @@ -329,19 +329,19 @@ <Filename Value="../../Units/MMLCore/files.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="files"/> - <CursorPos X="30" Y="20"/> - <TopLine Value="1"/> - <UsageCount Value="119"/> + <CursorPos X="15" Y="76"/> + <TopLine Value="47"/> + <EditorIndex Value="4"/> + <UsageCount Value="123"/> + <Loaded Value="True"/> </Unit40> <Unit41> <Filename Value="../../Units/MMLCore/window.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="Window"/> - <CursorPos X="29" Y="233"/> - <TopLine Value="233"/> - <EditorIndex Value="12"/> - <UsageCount Value="118"/> - <Loaded Value="True"/> + <CursorPos X="41" Y="243"/> + <TopLine Value="228"/> + <UsageCount Value="122"/> </Unit41> <Unit42> <Filename Value="../../../Documents/lazarus/lcl/forms.pp"/> @@ -355,8 +355,8 @@ <UnitName Value="CompTypes"/> <CursorPos X="35" Y="727"/> <TopLine Value="712"/> - <EditorIndex Value="6"/> - <UsageCount Value="21"/> + <EditorIndex Value="9"/> + <UsageCount Value="24"/> <Loaded Value="True"/> </Unit43> <Unit44> @@ -364,26 +364,24 @@ <UnitName Value="windowutil"/> <CursorPos X="86" Y="19"/> <TopLine Value="1"/> - <EditorIndex Value="13"/> - <UsageCount Value="41"/> - <Loaded Value="True"/> + <UsageCount Value="43"/> </Unit44> <Unit45> <Filename Value="../../Units/MMLCore/input.pas"/> <UnitName Value="Input"/> <CursorPos X="32" Y="251"/> <TopLine Value="220"/> - <EditorIndex Value="7"/> - <UsageCount Value="21"/> - <Loaded Value="True"/> + <UsageCount Value="23"/> </Unit45> <Unit46> <Filename Value="../../Units/MMLCore/finder.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="finder"/> - <CursorPos X="20" Y="29"/> - <TopLine Value="14"/> - <UsageCount Value="111"/> + <CursorPos X="79" Y="29"/> + <TopLine Value="15"/> + <EditorIndex Value="3"/> + <UsageCount Value="115"/> + <Loaded Value="True"/> </Unit46> <Unit47> <Filename Value="../../../lazarus/lcl/graphics.pp"/> @@ -396,9 +394,11 @@ <Filename Value="../../Units/MMLAddon/mmlthread.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="MMLThread"/> - <CursorPos X="132" Y="5"/> - <TopLine Value="1"/> - <UsageCount Value="109"/> + <CursorPos X="10" Y="62"/> + <TopLine Value="50"/> + <EditorIndex Value="11"/> + <UsageCount Value="113"/> + <Loaded Value="True"/> </Unit48> <Unit49> <Filename Value="../../../Documents/fpc/rtl/objpas/classes/classesh.inc"/> @@ -410,10 +410,10 @@ <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="mmlpsthread"/> - <CursorPos X="18" Y="177"/> - <TopLine Value="174"/> - <EditorIndex Value="8"/> - <UsageCount Value="107"/> + <CursorPos X="72" Y="15"/> + <TopLine Value="11"/> + <EditorIndex Value="10"/> + <UsageCount Value="111"/> <Loaded Value="True"/> </Unit50> <Unit51> @@ -521,11 +521,9 @@ </Unit65> <Unit66> <Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/> - <CursorPos X="49" Y="13"/> + <CursorPos X="33" Y="13"/> <TopLine Value="1"/> - <EditorIndex Value="9"/> - <UsageCount Value="28"/> - <Loaded Value="True"/> + <UsageCount Value="30"/> </Unit66> <Unit67> <Filename Value="../../../FPC/FPCCheckout/rtl/win/tthread.inc"/> @@ -543,9 +541,11 @@ <Filename Value="../../Units/MMLCore/bitmaps.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="bitmaps"/> - <CursorPos X="63" Y="428"/> - <TopLine Value="387"/> - <UsageCount Value="97"/> + <CursorPos X="31" Y="430"/> + <TopLine Value="419"/> + <EditorIndex Value="5"/> + <UsageCount Value="101"/> + <Loaded Value="True"/> </Unit69> <Unit70> <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.pp"/> @@ -565,7 +565,7 @@ <IsPartOfProject Value="True"/> <CursorPos X="30" Y="34"/> <TopLine Value="22"/> - <UsageCount Value="96"/> + <UsageCount Value="100"/> </Unit72> <Unit73> <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.inc"/> @@ -697,7 +697,7 @@ <UnitName Value="colour_conv"/> <CursorPos X="11" Y="148"/> <TopLine Value="140"/> - <UsageCount Value="79"/> + <UsageCount Value="83"/> </Unit92> <Unit93> <Filename Value="../../../cogat/Units/CogatUnits/compcolors.pas"/> @@ -756,7 +756,7 @@ <UnitName Value="plugins"/> <CursorPos X="86" Y="128"/> <TopLine Value="128"/> - <UsageCount Value="73"/> + <UsageCount Value="77"/> </Unit101> <Unit102> <Filename Value="../../../Compilertje/Units/CogatUnits/compfiles.pas"/> @@ -838,20 +838,20 @@ <Unit114> <Filename Value="../../../cogat/Units/CogatUnits/compdtm.pas"/> <UnitName Value="compDTM"/> - <CursorPos X="29" Y="11"/> - <TopLine Value="11"/> - <EditorIndex Value="5"/> - <UsageCount Value="16"/> + <CursorPos X="1" Y="377"/> + <TopLine Value="361"/> + <EditorIndex Value="8"/> + <UsageCount Value="19"/> <Loaded Value="True"/> </Unit114> <Unit115> <Filename Value="../../Units/MMLCore/dtm.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="dtm"/> - <CursorPos X="30" Y="133"/> - <TopLine Value="104"/> - <EditorIndex Value="3"/> - <UsageCount Value="54"/> + <CursorPos X="48" Y="128"/> + <TopLine Value="111"/> + <EditorIndex Value="6"/> + <UsageCount Value="58"/> <Loaded Value="True"/> </Unit115> <Unit116> @@ -865,9 +865,11 @@ <Filename Value="../../Units/MMLAddon/colourpicker.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="colourpicker"/> - <CursorPos X="27" Y="34"/> - <TopLine Value="13"/> - <UsageCount Value="50"/> + <CursorPos X="53" Y="33"/> + <TopLine Value="15"/> + <EditorIndex Value="12"/> + <UsageCount Value="54"/> + <Loaded Value="True"/> </Unit117> <Unit118> <Filename Value="../../../cogat/Units/CogatUnits/compdragger.pas"/> @@ -892,7 +894,7 @@ <UnitName Value="windowselector"/> <CursorPos X="76" Y="83"/> <TopLine Value="65"/> - <UsageCount Value="40"/> + <UsageCount Value="44"/> </Unit120> <Unit121> <Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/objpas/classes/classesh.inc"/> @@ -926,8 +928,8 @@ <UnitName Value="dtmutil"/> <CursorPos X="1" Y="17"/> <TopLine Value="1"/> - <EditorIndex Value="4"/> - <UsageCount Value="27"/> + <EditorIndex Value="7"/> + <UsageCount Value="31"/> <Loaded Value="True"/> </Unit125> <Unit126> @@ -939,133 +941,140 @@ </Unit126> <Unit127> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/dtm.inc"/> - <CursorPos X="85" Y="1"/> + <CursorPos X="26" Y="6"/> <TopLine Value="1"/> - <EditorIndex Value="10"/> - <UsageCount Value="11"/> + <EditorIndex Value="13"/> + <UsageCount Value="14"/> <Loaded Value="True"/> </Unit127> + <Unit128> + <Filename Value="../../../../Documents/lazarus/lcl/graphics.pp"/> + <UnitName Value="Graphics"/> + <CursorPos X="3" Y="53"/> + <TopLine Value="38"/> + <UsageCount Value="10"/> + </Unit128> </Units> <JumpHistory Count="30" HistoryIndex="29"> <Position1> - <Filename Value="../../../cogat/Units/CogatUnits/compdtm.pas"/> - <Caret Line="79" Column="21" TopLine="61"/> + <Filename Value="../../Units/MMLCore/dtm.pas"/> + <Caret Line="136" Column="47" TopLine="121"/> </Position1> <Position2> - <Filename Value="../../Units/MMLCore/dtmutil.pas"/> - <Caret Line="22" Column="4" TopLine="6"/> + <Filename Value="../../Units/MMLCore/dtm.pas"/> + <Caret Line="125" Column="25" TopLine="110"/> </Position2> <Position3> - <Filename Value="../../../cogat/Units/CogatUnits/compdtm.pas"/> - <Caret Line="79" Column="9" TopLine="61"/> + <Filename Value="../../Units/MMLCore/dtm.pas"/> + <Caret Line="77" Column="27" TopLine="51"/> </Position3> <Position4> - <Filename Value="../../Units/MMLCore/dtmutil.pas"/> - <Caret Line="23" Column="1" TopLine="11"/> + <Filename Value="../../Units/MMLCore/dtm.pas"/> + <Caret Line="431" Column="60" TopLine="401"/> </Position4> <Position5> <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="118" Column="25" TopLine="95"/> + <Caret Line="393" Column="28" TopLine="381"/> </Position5> <Position6> <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="199" Column="23" TopLine="131"/> + <Caret Line="386" Column="3" TopLine="375"/> </Position6> <Position7> <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="103" Column="7" TopLine="88"/> + <Caret Line="78" Column="20" TopLine="61"/> </Position7> <Position8> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="11" Column="42" TopLine="1"/> + <Filename Value="testunit.pas"/> + <Caret Line="11" Column="10" TopLine="1"/> </Position8> <Position9> <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="291" Column="31" TopLine="276"/> + <Caret Line="17" Column="78" TopLine="1"/> </Position9> <Position10> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="10" Column="45" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="196" Column="48" TopLine="196"/> </Position10> <Position11> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="5" Column="49" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="69" Column="3" TopLine="54"/> </Position11> <Position12> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="263" Column="31" TopLine="263"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="68" Column="1" TopLine="54"/> </Position12> <Position13> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="80" Column="60" TopLine="68"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="147" Column="4" TopLine="132"/> </Position13> <Position14> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="269" Column="53" TopLine="18"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="16" Column="37" TopLine="2"/> </Position14> <Position15> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="306" Column="48" TopLine="291"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="191" Column="14" TopLine="171"/> </Position15> <Position16> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="1" Column="77" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="24" Column="51" TopLine="19"/> </Position16> <Position17> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="12" Column="63" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="189" Column="1" TopLine="171"/> </Position17> <Position18> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="7" Column="46" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="10" Column="50" TopLine="9"/> </Position18> <Position19> - <Filename Value="../../Units/MMLCore/dtm.pas"/> - <Caret Line="6" Column="63" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="25" Column="41" TopLine="10"/> </Position19> <Position20> - <Filename Value="../../../cogat/Units/CogatUnits/compdtm.pas"/> - <Caret Line="11" Column="29" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="27" Column="47" TopLine="12"/> </Position20> <Position21> - <Filename Value="../../../cogat/Units/CogatUnits/comptypes.pas"/> - <Caret Line="11" Column="40" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="236" Column="7" TopLine="231"/> </Position21> <Position22> - <Filename Value="../../../cogat/Units/CogatUnits/comptypes.pas"/> - <Caret Line="137" Column="11" TopLine="122"/> + <Filename Value="../../Units/MMLAddon/mmlthread.pas"/> + <Caret Line="5" Column="132" TopLine="1"/> </Position22> <Position23> - <Filename Value="../../../cogat/Units/CogatUnits/comptypes.pas"/> - <Caret Line="138" Column="17" TopLine="122"/> + <Filename Value="../../Units/MMLAddon/colourpicker.pas"/> + <Caret Line="34" Column="27" TopLine="13"/> </Position23> <Position24> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="40" Column="55" TopLine="27"/> + <Filename Value="../../Units/MMLAddon/colourpicker.pas"/> + <Caret Line="87" Column="10" TopLine="72"/> </Position24> <Position25> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="44" Column="27" TopLine="27"/> + <Filename Value="../../Units/MMLAddon/colourpicker.pas"/> + <Caret Line="28" Column="33" TopLine="13"/> </Position25> <Position26> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="139" Column="22" TopLine="121"/> + <Filename Value="../../Units/MMLAddon/colourpicker.pas"/> + <Caret Line="105" Column="37" TopLine="90"/> </Position26> <Position27> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="138" Column="22" TopLine="121"/> + <Filename Value="../../Units/MMLAddon/colourpicker.pas"/> + <Caret Line="156" Column="39" TopLine="141"/> </Position27> <Position28> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="139" Column="32" TopLine="121"/> + <Filename Value="../../Units/MMLAddon/colourpicker.pas"/> + <Caret Line="30" Column="49" TopLine="15"/> </Position28> <Position29> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="177" Column="18" TopLine="174"/> + <Caret Line="8" Column="76" TopLine="1"/> </Position29> <Position30> - <Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/> - <Caret Line="15" Column="1" TopLine="1"/> + <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> + <Caret Line="105" Column="38" TopLine="90"/> </Position30> </JumpHistory> </ProjectOptions> diff --git a/Units/MMLAddon/PSInc/Wrappers/dtm.inc b/Units/MMLAddon/PSInc/Wrappers/dtm.inc index 98b76ab..83ed77a 100644 --- a/Units/MMLAddon/PSInc/Wrappers/dtm.inc +++ b/Units/MMLAddon/PSInc/Wrappers/dtm.inc @@ -3,7 +3,7 @@ begin Result := CurrThread.Client.MDTM.FindDTM(DTM, x, y, x1, y1, x2, y2); end; -function ps_StringFromDTM(DTMString: String): Integer; +function ps_DTMFromString(DTMString: String): Integer; var dtm: pDTM; begin diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index 77070a2..0620063 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 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);'); - - - - - - - + +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_DTMFromString, '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/MMLAddon/colourpicker.pas b/Units/MMLAddon/colourpicker.pas index b239e05..f14f6c8 100644 --- a/Units/MMLAddon/colourpicker.pas +++ b/Units/MMLAddon/colourpicker.pas @@ -83,7 +83,8 @@ begin Window.SetTarget(Window.DesktopWindow); {$ENDIF} {$ENDIF} - + w := 0; + h := 0; Window.GetDimensions(w, h); Form.Width := w; diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 7c33161..dc7beae 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -5,7 +5,7 @@ unit mmlpsthread; interface uses - Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, Plugins,uPSPreProcessor; + Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, uPSPreProcessor; type @@ -65,8 +65,7 @@ begin end; function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; -var - i : integer; + begin; Writeln('We have a length of: ' + inttostr(length(v))); Try @@ -145,7 +144,7 @@ procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor; const DirectiveName, DirectiveParam: string; var Continue: Boolean); var TempNum : integer; - I,II : integer; + I: integer; begin if DirectiveName= 'LOADDLL' then if DirectiveParam <> '' then @@ -187,6 +186,7 @@ function TMMLPSThread.RequireFile(Sender: TObject; const OriginFileName: String; var FileName, OutPut: string): Boolean; begin + Result := False; end; procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler); @@ -232,7 +232,7 @@ end; procedure TMMLPSThread.Execute; var - time, i, ii: Integer; + time: Integer; begin; CurrThread := Self; time := lclintf.GetTickCount; diff --git a/Units/MMLAddon/mmlthread.pas b/Units/MMLAddon/mmlthread.pas index bc71212..80904ae 100644 --- a/Units/MMLAddon/mmlthread.pas +++ b/Units/MMLAddon/mmlthread.pas @@ -58,7 +58,8 @@ var i,w,h: Integer; begin - + w := 0; + h := 0; i := 0; while (not Terminated) and (i < 10) do begin diff --git a/Units/MMLCore/dtm.pas b/Units/MMLCore/dtm.pas index b56fac3..a2b80ef 100644 --- a/Units/MMLCore/dtm.pas +++ b/Units/MMLCore/dtm.pas @@ -1,322 +1,448 @@ -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. - +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 + function AreaShape(Color, Tolerance, Size, Shape: Integer; P: TPoint) : Boolean; inline; + 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, finder, + graphics, // for TColor + math // for max + ; + +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; +{$DEFINE DTM_DEBUG} +destructor TMDTM.Destroy; + +{$IFDEF DTM_DEBUG} +var + i, j: integer; + b:boolean; +{$ENDIF} +begin + {$IFDEF DTM_DEBUG} + writeln(inttostr(high(dtmlist))); + writeln(inttostr(high(freespots))); + for i := 0 to high(DTMList) do + begin + b := false; + for j := 0 to high(freespots) do + if i = freespots[j] then + begin + b := true; + break; + end; + if not b then + writeln('DTM Number ' + inttostr(i) + ' was not freed'); + end; + {$ENDIF} + SetLength(DTMList, 0); + SetLength(FreeSpots, 0); + SetLength(BufferString, 0); + + inherited Destroy; +end; + +type + PMSimColor = function (Color1,Color2,Tolerance : Integer) : boolean of object; + PMGetCol = function (x, y: integer): TColor of object; + +Function TMDTM.AreaShape(Color, Tolerance, Size, Shape: Integer; P: TPoint) : Boolean; inline; + +Var + X, Y, S: Integer; + SimCol: PMSimColor; + GetCol: PMGetCol; + +Begin + writeln('areashape'); + SimCol := @TClient(Client).MFinder.SimilarColors; + GetCol := @TClient(Client).MWindow.GetColor; + Case Shape Of + dtm_Rectangle: + Begin + { + Example: + 3x3 + X X X + X X X + X X X + } + For X := P.X - Size To P.X + Size Do + For Y := P.Y - Size To P.Y + Size Do + If SimCol(GetCol(X, Y), Color, Tolerance) Then + Begin + Result := True; + Exit; + End; + End; + + dtm_Cross: + { + Example: + 3x3 + X + X X X + X + } + Begin + For X := P.X - Size To P.X + Size Do + If SimCol(GetCol(X, P.Y), Color, Tolerance) Then + Begin + Result := True; + Exit; + End; + For Y := P.Y - Size To P.Y + Size Do + If SimCol(GetCol(P.X, Y), Color, Tolerance) Then + Begin + Result := True; + Exit; + End; + End; + + dtm_DiagonalCross: + { + Example: + 3x3 + X X + X + X X + + } + Begin + For S := -Size To Size Do + Begin + If SimCol(GetCol(P.X + S, P.Y + S), Color, Tolerance) Then + Begin + Result := True; + Exit; + End; + If SimCol(GetCol(P.X + S, P.Y - S), Color, Tolerance) Then + Begin + Result := True; + Exit; + End; + End; + End; + + {4: + Begin + D := Ceil(Sqrt(Pow(Size, 2) + Pow(Size, 2))); + //Will finish later + + End; } + + Else + WriteLn('Incorrect Shape'); + End; + Result := False; +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; + MaxSubPointDist: TPoint; + +begin + MaxSubPointDist := Point(0,0); + + 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; + MaxSubPointDist.X := Max(DTM.p[I].x, MaxSubPointDist.X); + MaxSubPointDist.Y := Max(DTM.p[I].y, MaxSubPointDist.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 + 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. +