mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-22 23:38:50 -05:00
Added freeze() to colour test.
Fixed a bug in cts 0, made cst 1 20% faster. Only cts 2 left to optimise. (Can be optimised a lot!) git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@94 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup?
parent
8ae45b0237
commit
950bf6cfa9
@ -33,15 +33,15 @@
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="123">
|
||||
<Units Count="125">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="project1"/>
|
||||
<CursorPos X="17" Y="12"/>
|
||||
<CursorPos X="10" Y="7"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="141"/>
|
||||
<UsageCount Value="143"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
@ -170,10 +170,10 @@
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="TestUnit"/>
|
||||
<CursorPos X="51" Y="133"/>
|
||||
<TopLine Value="110"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<UsageCount Value="107"/>
|
||||
<CursorPos X="37" Y="115"/>
|
||||
<TopLine Value="83"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<UsageCount Value="109"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit18>
|
||||
<Unit19>
|
||||
@ -305,7 +305,7 @@
|
||||
<CursorPos X="25" Y="17"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="106"/>
|
||||
<UsageCount Value="108"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit37>
|
||||
<Unit38>
|
||||
@ -315,7 +315,7 @@
|
||||
<CursorPos X="69" Y="25"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="106"/>
|
||||
<UsageCount Value="108"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit38>
|
||||
<Unit39>
|
||||
@ -331,7 +331,7 @@
|
||||
<UnitName Value="files"/>
|
||||
<CursorPos X="37" Y="42"/>
|
||||
<TopLine Value="271"/>
|
||||
<UsageCount Value="107"/>
|
||||
<UsageCount Value="109"/>
|
||||
</Unit40>
|
||||
<Unit41>
|
||||
<Filename Value="../../Units/MMLCore/window.pas"/>
|
||||
@ -339,8 +339,8 @@
|
||||
<UnitName Value="Window"/>
|
||||
<CursorPos X="24" Y="84"/>
|
||||
<TopLine Value="75"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<UsageCount Value="106"/>
|
||||
<EditorIndex Value="12"/>
|
||||
<UsageCount Value="108"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit41>
|
||||
<Unit42>
|
||||
@ -355,8 +355,8 @@
|
||||
<UnitName Value="CompTypes"/>
|
||||
<CursorPos X="59" Y="545"/>
|
||||
<TopLine Value="524"/>
|
||||
<EditorIndex Value="14"/>
|
||||
<UsageCount Value="17"/>
|
||||
<EditorIndex Value="16"/>
|
||||
<UsageCount Value="18"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit43>
|
||||
<Unit44>
|
||||
@ -364,8 +364,8 @@
|
||||
<UnitName Value="windowutil"/>
|
||||
<CursorPos X="86" Y="19"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<UsageCount Value="35"/>
|
||||
<EditorIndex Value="13"/>
|
||||
<UsageCount Value="36"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit44>
|
||||
<Unit45>
|
||||
@ -374,17 +374,17 @@
|
||||
<CursorPos X="32" Y="251"/>
|
||||
<TopLine Value="220"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<UsageCount Value="15"/>
|
||||
<UsageCount Value="16"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit45>
|
||||
<Unit46>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="finder"/>
|
||||
<CursorPos X="57" Y="15"/>
|
||||
<TopLine Value="2"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="99"/>
|
||||
<CursorPos X="70" Y="304"/>
|
||||
<TopLine Value="272"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<UsageCount Value="101"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit46>
|
||||
<Unit47>
|
||||
@ -400,7 +400,7 @@
|
||||
<UnitName Value="MMLThread"/>
|
||||
<CursorPos X="132" Y="5"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="97"/>
|
||||
<UsageCount Value="99"/>
|
||||
</Unit48>
|
||||
<Unit49>
|
||||
<Filename Value="../../../Documents/fpc/rtl/objpas/classes/classesh.inc"/>
|
||||
@ -412,10 +412,10 @@
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="mmlpsthread"/>
|
||||
<CursorPos X="66" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="46" Y="167"/>
|
||||
<TopLine Value="157"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<UsageCount Value="95"/>
|
||||
<UsageCount Value="97"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit50>
|
||||
<Unit51>
|
||||
@ -523,9 +523,11 @@
|
||||
</Unit65>
|
||||
<Unit66>
|
||||
<Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/>
|
||||
<CursorPos X="23" Y="15"/>
|
||||
<CursorPos X="54" Y="17"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<UsageCount Value="28"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit66>
|
||||
<Unit67>
|
||||
<Filename Value="../../../FPC/FPCCheckout/rtl/win/tthread.inc"/>
|
||||
@ -545,7 +547,7 @@
|
||||
<UnitName Value="bitmaps"/>
|
||||
<CursorPos X="63" Y="428"/>
|
||||
<TopLine Value="387"/>
|
||||
<UsageCount Value="85"/>
|
||||
<UsageCount Value="87"/>
|
||||
</Unit69>
|
||||
<Unit70>
|
||||
<Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.pp"/>
|
||||
@ -565,7 +567,7 @@
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CursorPos X="30" Y="34"/>
|
||||
<TopLine Value="22"/>
|
||||
<UsageCount Value="84"/>
|
||||
<UsageCount Value="86"/>
|
||||
</Unit72>
|
||||
<Unit73>
|
||||
<Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.inc"/>
|
||||
@ -698,7 +700,7 @@
|
||||
<CursorPos X="53" Y="27"/>
|
||||
<TopLine Value="9"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="67"/>
|
||||
<UsageCount Value="69"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit92>
|
||||
<Unit93>
|
||||
@ -718,7 +720,9 @@
|
||||
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="9"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<UsageCount Value="10"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit95>
|
||||
<Unit96>
|
||||
<Filename Value="../../Units/PascalScript/uPSCompiler.pas"/>
|
||||
@ -758,7 +762,7 @@
|
||||
<UnitName Value="plugins"/>
|
||||
<CursorPos X="86" Y="128"/>
|
||||
<TopLine Value="128"/>
|
||||
<UsageCount Value="61"/>
|
||||
<UsageCount Value="63"/>
|
||||
</Unit101>
|
||||
<Unit102>
|
||||
<Filename Value="../../../Compilertje/Units/CogatUnits/compfiles.pas"/>
|
||||
@ -788,7 +792,7 @@
|
||||
</Unit105>
|
||||
<Unit106>
|
||||
<Filename Value="../../Units/MMLAddon/PSInc/psdefines.inc"/>
|
||||
<CursorPos X="57" Y="4"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="14"/>
|
||||
</Unit106>
|
||||
@ -850,7 +854,7 @@
|
||||
<UnitName Value="dtm"/>
|
||||
<CursorPos X="52" Y="15"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="42"/>
|
||||
<UsageCount Value="44"/>
|
||||
</Unit115>
|
||||
<Unit116>
|
||||
<Filename Value="../../../cogat/Units/CogatUnits/comppicker.pas"/>
|
||||
@ -866,7 +870,7 @@
|
||||
<CursorPos X="27" Y="34"/>
|
||||
<TopLine Value="13"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="38"/>
|
||||
<UsageCount Value="40"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit117>
|
||||
<Unit118>
|
||||
@ -874,8 +878,8 @@
|
||||
<UnitName Value="CompDragger"/>
|
||||
<CursorPos X="101" Y="26"/>
|
||||
<TopLine Value="26"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<UsageCount Value="16"/>
|
||||
<EditorIndex Value="14"/>
|
||||
<UsageCount Value="17"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit118>
|
||||
<Unit119>
|
||||
@ -884,11 +888,9 @@
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="MainForm"/>
|
||||
<CursorPos X="48" Y="1180"/>
|
||||
<TopLine Value="1161"/>
|
||||
<EditorIndex Value="12"/>
|
||||
<CursorPos X="29" Y="635"/>
|
||||
<TopLine Value="612"/>
|
||||
<UsageCount Value="16"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit119>
|
||||
<Unit120>
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
@ -896,8 +898,8 @@
|
||||
<UnitName Value="windowselector"/>
|
||||
<CursorPos X="76" Y="83"/>
|
||||
<TopLine Value="65"/>
|
||||
<EditorIndex Value="13"/>
|
||||
<UsageCount Value="28"/>
|
||||
<EditorIndex Value="15"/>
|
||||
<UsageCount Value="30"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit120>
|
||||
<Unit121>
|
||||
@ -913,120 +915,143 @@
|
||||
<TopLine Value="338"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit122>
|
||||
<Unit123>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
|
||||
<UnitName Value="cthreads"/>
|
||||
<CursorPos X="28" Y="1077"/>
|
||||
<TopLine Value="1070"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="11"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit123>
|
||||
<Unit124>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/inc/threadh.inc"/>
|
||||
<CursorPos X="58" Y="78"/>
|
||||
<TopLine Value="59"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit124>
|
||||
</Units>
|
||||
<JumpHistory Count="28" HistoryIndex="27">
|
||||
<JumpHistory Count="30" HistoryIndex="29">
|
||||
<Position1>
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
<Caret Line="40" Column="26" TopLine="25"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="25" Column="37" TopLine="25"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="96" Column="43" TopLine="85"/>
|
||||
<Caret Line="46" Column="25" TopLine="25"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
<Caret Line="77" Column="14" TopLine="49"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
<Caret Line="11" Column="29" TopLine="1"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
<Caret Line="9" Column="10" TopLine="1"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="52" Column="43" TopLine="52"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="54" Column="45" TopLine="54"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
<Caret Line="72" Column="74" TopLine="59"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="../../Units/MMLCore/client.pas"/>
|
||||
<Caret Line="17" Column="25" TopLine="1"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
<Caret Line="79" Column="32" TopLine="65"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="../../Units/MMLAddon/colourpicker.pas"/>
|
||||
<Caret Line="56" Column="47" TopLine="37"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="../../Units/MMLAddon/colourpicker.pas"/>
|
||||
<Caret Line="74" Column="19" TopLine="49"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="../../Units/MMLAddon/colourpicker.pas"/>
|
||||
<Caret Line="34" Column="27" TopLine="13"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="7" Column="90" TopLine="1"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="82" Column="17" TopLine="63"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="266" Column="51" TopLine="247"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="295" Column="55" TopLine="276"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="327" Column="53" TopLine="308"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="368" Column="53" TopLine="349"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="1004" Column="48" TopLine="985"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="1005" Column="43" TopLine="985"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="../../../cogat/mainform.pas"/>
|
||||
<Caret Line="1008" Column="46" TopLine="985"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="35" Column="78" TopLine="1"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="25" Column="37" TopLine="25"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="46" Column="25" TopLine="25"/>
|
||||
</Position25>
|
||||
<Position26>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="47" Column="25" TopLine="25"/>
|
||||
</Position26>
|
||||
<Position27>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="136" Column="48" TopLine="108"/>
|
||||
</Position27>
|
||||
<Position28>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="139" Column="15" TopLine="117"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<Caret Line="7" Column="10" TopLine="1"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
|
||||
<Caret Line="12" Column="46" TopLine="1"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
|
||||
<Caret Line="313" Column="20" TopLine="294"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
|
||||
<Caret Line="321" Column="31" TopLine="294"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
|
||||
<Caret Line="327" Column="31" TopLine="294"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
|
||||
<Caret Line="343" Column="18" TopLine="324"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
|
||||
<Caret Line="346" Column="12" TopLine="324"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
|
||||
<Caret Line="1077" Column="28" TopLine="1070"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="92" Column="29" TopLine="73"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
<Caret Line="11" Column="86" TopLine="2"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
<Caret Line="32" Column="38" TopLine="2"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
<Caret Line="307" Column="52" TopLine="269"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
<Caret Line="48" Column="71" TopLine="10"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
<Caret Line="238" Column="59" TopLine="233"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
<Caret Line="33" Column="65" TopLine="13"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
<Caret Line="285" Column="5" TopLine="253"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="134" Column="22" TopLine="108"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/>
|
||||
<Caret Line="16" Column="12" TopLine="1"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="134" Column="22" TopLine="108"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="112" Column="19" TopLine="79"/>
|
||||
</Position25>
|
||||
<Position26>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="176" Column="20" TopLine="151"/>
|
||||
</Position26>
|
||||
<Position27>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="134" Column="24" TopLine="115"/>
|
||||
</Position27>
|
||||
<Position28>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="176" Column="7" TopLine="146"/>
|
||||
</Position28>
|
||||
<Position29>
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<Caret Line="179" Column="71" TopLine="157"/>
|
||||
</Position29>
|
||||
<Position30>
|
||||
<Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/>
|
||||
<Caret Line="15" Column="95" TopLine="1"/>
|
||||
</Position30>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
@ -1035,8 +1060,8 @@
|
||||
<Filename Value="SAMufasaGUI"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)/"/>
|
||||
<OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/"/>
|
||||
<IncludeFiles Value="$(ProjOutDir)/;$(ProjPath)../../Units/MMLAddon/PSInc/"/>
|
||||
<OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Optimizations>
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TForm1','FORMDATA',[
|
||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'{'#4#6'Height'#3#29#2#3'Top'#3#148#0#5'Wi'
|
||||
+'dth'#3#251#2#13'ActiveControl'#7#8'SynEdit1'#7'Caption'#6#9'Mufasa v2'#12'C'
|
||||
|
||||
@ -87,6 +87,10 @@ begin
|
||||
MMLPSThread.Client.MWindow.SetWindow(Form1.Window);
|
||||
|
||||
MMLPSThread.Resume;
|
||||
|
||||
// sleep(500);
|
||||
// MMLPSThread.PSScript.Stop;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
|
||||
@ -3,20 +3,20 @@ var
|
||||
x,y,w,h,i,j,t,t2:integer;
|
||||
begin
|
||||
getclientdimensions(w,h);
|
||||
writeln(inttostr(w) + ', ' + inttostr(h));
|
||||
|
||||
writeln(inttostr(w) + ', ' + inttostr(h));
|
||||
|
||||
freeze();
|
||||
for i := 0 to 2 do
|
||||
begin
|
||||
setcolortolerancespeed(i);
|
||||
t := getsystemtime;
|
||||
for j := 0 to 100 do
|
||||
findcolortolerance(x, y, 255, 0, 0, w -1 , h -1, 40);
|
||||
findcolortolerance(x, y, 2532562, 0, 0, w -1 , h -1, 1);
|
||||
t2 := getsystemtime;
|
||||
writeln('Time for 101 tries: ' + inttostr(t2 - t) + ' ms.');
|
||||
writeln('That is ' + FloatToStr((t2 - t) / 101) + ' ms each.');
|
||||
|
||||
if findcolortolerance(x, y, 255, 0, 0, w-1, h-1, 40) then
|
||||
if findcolortolerance(x, y, 2532562, 0, 0, w-1, h-1, 1) then
|
||||
begin
|
||||
writeln('CTS: ' + inttostr(I) + '; Found the colour at (' + inttostr(x) + ', ' +
|
||||
inttostr(y) + ')');
|
||||
@ -25,6 +25,7 @@ begin
|
||||
end else
|
||||
writeln('not found');
|
||||
end;
|
||||
unfreeze();
|
||||
end.
|
||||
|
||||
Compiled succesfully in 7 ms.
|
||||
|
||||
@ -8,3 +8,12 @@ begin
|
||||
Sleep(t);
|
||||
end;
|
||||
|
||||
function Freeze: boolean;
|
||||
begin
|
||||
result := CurrThread.Client.MWindow.Freeze();
|
||||
end;
|
||||
|
||||
function Unfreeze: boolean;
|
||||
begin
|
||||
result := CurrThread.Client.MWindow.Unfreeze;
|
||||
end;
|
||||
|
||||
@ -1,57 +1,60 @@
|
||||
|
||||
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
|
||||
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
|
||||
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
|
||||
|
||||
|
||||
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
|
||||
|
||||
|
||||
{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(@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.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
|
||||
|
||||
|
||||
{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);');
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -16,7 +16,6 @@ type
|
||||
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
|
||||
const DirectiveName, DirectiveParam: string; var Continue: Boolean);
|
||||
protected
|
||||
PSScript : TPSScript;
|
||||
DebugTo : TMemo;
|
||||
PluginsToload : Array of integer;
|
||||
procedure OnCompile(Sender: TPSScript);
|
||||
@ -29,6 +28,7 @@ type
|
||||
procedure OnThreadTerminate(Sender: TObject);
|
||||
procedure Execute; override;
|
||||
public
|
||||
PSScript : TPSScript; // Moved to public, as we can't kill it otherwise.
|
||||
Client : TClient;
|
||||
procedure SetPSScript(Script : string);
|
||||
procedure SetDebug( Strings : TMemo );
|
||||
|
||||
@ -1,442 +1,447 @@
|
||||
unit finder;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, MufasaTypes; // Types
|
||||
|
||||
{ TMFinder Class }
|
||||
|
||||
{
|
||||
Should be 100% independant, as all platform dependant code is in the
|
||||
Window and Input classes.
|
||||
|
||||
Let's try not to use any OS-specific defines here? ;)
|
||||
}
|
||||
|
||||
type
|
||||
TMFinder = class(TObject)
|
||||
constructor Create(aClient: TObject);
|
||||
destructor Destroy; override;
|
||||
private
|
||||
Procedure UpdateCachedValues(NewWidth,NewHeight : integer);
|
||||
procedure DefaultOperations(var x1,y1,x2,y2 : integer);
|
||||
public
|
||||
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
|
||||
procedure SetToleranceSpeed(nCTS: Integer);
|
||||
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
|
||||
// Possibly turn x, y into a TPoint var.
|
||||
function FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
function FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean;
|
||||
function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean;
|
||||
function FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
protected
|
||||
Client: TObject;
|
||||
CachedWidth, CachedHeight : integer;
|
||||
ClientTPA : TPointArray;
|
||||
hueMod, satMod: Extended;
|
||||
CTS: Integer;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
Client, // For the Client Casts.
|
||||
colour_conv // For RGBToColor, etc.
|
||||
;
|
||||
|
||||
|
||||
constructor TMFinder.Create(aClient: TObject);
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
Self.Client := aClient;
|
||||
Self.CTS := 1;
|
||||
Self.hueMod := 0.2;
|
||||
Self.satMod := 0.2;
|
||||
|
||||
end;
|
||||
|
||||
destructor TMFinder.Destroy;
|
||||
begin
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TMFinder.SetToleranceSpeed(nCTS: Integer);
|
||||
begin
|
||||
if (nCTS < 0) or (nCTS > 2) then
|
||||
raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]);
|
||||
Self.CTS := nCTS;
|
||||
end;
|
||||
|
||||
function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean;
|
||||
var
|
||||
R1,G1,B1,R2,G2,B2 : Byte;
|
||||
H1,S1,L1,H2,S2,L2 : extended;
|
||||
begin
|
||||
Result := False;
|
||||
ColorToRGB(Color1,R1,G1,B1);
|
||||
ColorToRGB(Color2,R2,G2,B2);
|
||||
if Color1 = Color2 then
|
||||
Result := true
|
||||
else
|
||||
case CTS of
|
||||
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
|
||||
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
|
||||
2: begin
|
||||
RGBToHSL(R1,g1,b1,H1,S1,L1);
|
||||
RGBToHSL(R2,g2,b2,H2,S2,L2);
|
||||
Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function ColorSame(var CTS,Tolerance : Integer; var R1,B1,G1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline;
|
||||
var
|
||||
H2,S2,L2 : extended;
|
||||
begin
|
||||
Result := False;
|
||||
case CTS of
|
||||
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
|
||||
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
|
||||
2: begin
|
||||
RGBToHSL(R1,g1,b1,H1,S1,L1);
|
||||
RGBToHSL(R2,g2,b2,H2,S2,L2);
|
||||
Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer);
|
||||
begin
|
||||
CachedWidth := NewWidth;
|
||||
CachedHeight := NewHeight;
|
||||
SetLength(ClientTPA,NewWidth * NewHeight);
|
||||
end;
|
||||
|
||||
procedure TMFinder.DefaultOperations(var x1, y1, x2, y2: integer);
|
||||
var
|
||||
w,h : integer;
|
||||
begin
|
||||
{ if x1 > x2 then
|
||||
Swap(x1,x2);
|
||||
if y1 > y2 then
|
||||
Swap(y1,y2);}
|
||||
if x1 < 0 then
|
||||
// x1 := 0;
|
||||
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
|
||||
'correct x1: %d.', [x1]);
|
||||
if y1 < 0 then
|
||||
// y1 := 0;
|
||||
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
|
||||
'correct y1: %d.', [y1]);
|
||||
|
||||
TClient(Self.Client).MWindow.GetDimensions(w,h);
|
||||
if (w <> CachedWidth) or (h <> CachedHeight) then
|
||||
UpdateCachedValues(w,h);
|
||||
if x2 >= w then
|
||||
// x2 := w-1;
|
||||
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
|
||||
'correct x2: %d.', [x2]);
|
||||
if y2 >= h then
|
||||
// y2 := h-1;
|
||||
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
|
||||
'correct y2: %d.', [y2]);
|
||||
end;
|
||||
|
||||
function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
clR, clG, clB : byte;
|
||||
dX, dY, xx, yy: Integer;
|
||||
h,s,l,hmod,smod : extended;
|
||||
Ccts : integer;
|
||||
begin
|
||||
DefaultOperations(xs, ys, xe, ye);
|
||||
dX := xe - xs;
|
||||
dY := ye - ys;
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
CCts := Self.CTS;
|
||||
result := 0;
|
||||
if cts = 2 then
|
||||
begin;
|
||||
RGBToHSL(clR,clG,clB,h,s,l);
|
||||
hmod := Self.hueMod;
|
||||
smod := Self.satMod;
|
||||
end;
|
||||
for yy := ys to ye do
|
||||
begin;
|
||||
for xx := xs to xe do
|
||||
begin;
|
||||
if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then
|
||||
inc(result);
|
||||
Inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc)
|
||||
end;
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy: Integer;
|
||||
|
||||
begin
|
||||
|
||||
// checks for valid x1,y1,x2,y2? (may involve GetDimensions)
|
||||
DefaultOperations(x1,y1,x2,y2);
|
||||
|
||||
// calculate delta x and y
|
||||
dX := x2 - x1;
|
||||
dY := y2 - y1;
|
||||
|
||||
//next, convert the color to r,g,b
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
|
||||
|
||||
// Do we want to "cache" these vars?
|
||||
// We will, for now. Easier to type.
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
|
||||
for yy := y1 to y2 do
|
||||
begin;
|
||||
for xx := x1 to x2 do
|
||||
begin;
|
||||
// Colour comparison here. Possibly with tolerance? ;)
|
||||
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
|
||||
begin
|
||||
Result := True;
|
||||
x := xx;
|
||||
y := yy;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
Exit;
|
||||
end;
|
||||
Inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc)
|
||||
end;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy: Integer;
|
||||
H1, S1, L1, H2, S2, L2: Extended;
|
||||
|
||||
label Hit;
|
||||
label Miss;
|
||||
|
||||
begin
|
||||
|
||||
// checks for valid x1,y1,x2,y2? (may involve GetDimensions)
|
||||
DefaultOperations(x1,y1,x2,y2);
|
||||
|
||||
// calculate delta x and y
|
||||
dX := x2 - x1;
|
||||
dY := y2 - y1;
|
||||
//next, convert the color to r,g,b
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
ColorToHSL(Color, H1, S1, L1);
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
|
||||
|
||||
// Do we want to "cache" these vars?
|
||||
// We will, for now. Easier to type.
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
|
||||
case CTS of
|
||||
0:
|
||||
for yy := y1 to y2 do
|
||||
begin
|
||||
for xx := x1 to x2 do
|
||||
begin
|
||||
if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then
|
||||
goto Hit;
|
||||
inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
|
||||
1:
|
||||
for yy := y1 to y2 do
|
||||
begin
|
||||
for xx := x1 to x2 do
|
||||
begin
|
||||
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
|
||||
goto Hit;
|
||||
inc(ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
for yy := y1 to y2 do
|
||||
for xx := x1 to x2 do
|
||||
begin
|
||||
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
|
||||
if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then
|
||||
goto Hit;
|
||||
inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
end;
|
||||
Result := False;
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
Exit;
|
||||
|
||||
Hit:
|
||||
Result := True;
|
||||
x := xx;
|
||||
y := yy;
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColorsTolerance(var Points: TPointArray; Color, xs, ys,
|
||||
xe, ye, Tol: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc,C: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy: Integer;
|
||||
H1, S1, L1, H2, S2, L2: Extended;
|
||||
begin
|
||||
DefaultOperations(xs,ys,xe,ye);
|
||||
|
||||
dX := xe - xs;
|
||||
dY := ye - ys;
|
||||
//next, convert the color to r,g,b
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
ColorToHSL(Color, H1, S1, L1);
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
|
||||
|
||||
// Do we want to "cache" these vars?
|
||||
// We will, for now. Easier to type.
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
c := 0;
|
||||
case CTS of
|
||||
0:
|
||||
for yy := ys to ye do
|
||||
begin
|
||||
for xx := xs to xe do
|
||||
begin
|
||||
if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then
|
||||
begin;
|
||||
ClientTPA[c].x := xx;
|
||||
ClientTPA[c].y := yy;
|
||||
inc(c);
|
||||
end;
|
||||
inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
|
||||
1:
|
||||
for yy := ys to ye do
|
||||
begin
|
||||
for xx := xs to xe do
|
||||
begin
|
||||
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
|
||||
begin;
|
||||
ClientTPA[c].x := xx;
|
||||
ClientTPA[c].y := yy;
|
||||
inc(c);
|
||||
end;
|
||||
inc(ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
for yy := ys to ye do
|
||||
for xx := xs to xe do
|
||||
begin
|
||||
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
|
||||
if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then
|
||||
begin;
|
||||
ClientTPA[c].x := xx;
|
||||
ClientTPA[c].y := yy;
|
||||
inc(c);
|
||||
end;
|
||||
inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
end;
|
||||
SetLength(Points, C);
|
||||
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
|
||||
Result := C > 0;
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy, i: Integer;
|
||||
|
||||
begin
|
||||
DefaultOperations(x1,y1,x2,y2);
|
||||
|
||||
dX := x2 - x1;
|
||||
dY := y2 - y1;
|
||||
|
||||
I := 0;
|
||||
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
|
||||
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
|
||||
for yy := y1 to y2 do
|
||||
begin;
|
||||
for xx := x1 to x2 do
|
||||
begin;
|
||||
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
|
||||
begin
|
||||
Self.ClientTPA[I].x := xx;
|
||||
Self.ClientTPA[i].y := yy;
|
||||
Inc(I);
|
||||
end;
|
||||
Inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
|
||||
SetLength(TPA, I);
|
||||
|
||||
Move(ClientTPA[0], TPA[0], i * SizeOf(TPoint));
|
||||
|
||||
Result := I > 0;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit finder;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, MufasaTypes; // Types
|
||||
|
||||
{ TMFinder Class }
|
||||
|
||||
{
|
||||
Should be 100% independant, as all platform dependant code is in the
|
||||
Window and Input classes.
|
||||
|
||||
Let's try not to use any OS-specific defines here? ;)
|
||||
}
|
||||
|
||||
type
|
||||
TMFinder = class(TObject)
|
||||
constructor Create(aClient: TObject);
|
||||
destructor Destroy; override;
|
||||
private
|
||||
Procedure UpdateCachedValues(NewWidth,NewHeight : integer);
|
||||
procedure DefaultOperations(var x1,y1,x2,y2 : integer);
|
||||
public
|
||||
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
|
||||
procedure SetToleranceSpeed(nCTS: Integer);
|
||||
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
|
||||
// Possibly turn x, y into a TPoint var.
|
||||
function FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
function FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean;
|
||||
function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean;
|
||||
function FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
protected
|
||||
Client: TObject;
|
||||
CachedWidth, CachedHeight : integer;
|
||||
ClientTPA : TPointArray;
|
||||
hueMod, satMod: Extended;
|
||||
CTS: Integer;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
Client, // For the Client Casts.
|
||||
colour_conv // For RGBToColor, etc.
|
||||
;
|
||||
|
||||
|
||||
constructor TMFinder.Create(aClient: TObject);
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
Self.Client := aClient;
|
||||
Self.CTS := 1;
|
||||
Self.hueMod := 0.2;
|
||||
Self.satMod := 0.2;
|
||||
|
||||
end;
|
||||
|
||||
destructor TMFinder.Destroy;
|
||||
begin
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TMFinder.SetToleranceSpeed(nCTS: Integer);
|
||||
begin
|
||||
if (nCTS < 0) or (nCTS > 2) then
|
||||
raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]);
|
||||
Self.CTS := nCTS;
|
||||
end;
|
||||
|
||||
function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean;
|
||||
var
|
||||
R1,G1,B1,R2,G2,B2 : Byte;
|
||||
H1,S1,L1,H2,S2,L2 : extended;
|
||||
begin
|
||||
Result := False;
|
||||
ColorToRGB(Color1,R1,G1,B1);
|
||||
ColorToRGB(Color2,R2,G2,B2);
|
||||
if Color1 = Color2 then
|
||||
Result := true
|
||||
else
|
||||
case CTS of
|
||||
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
|
||||
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
|
||||
2: begin
|
||||
RGBToHSL(R1,g1,b1,H1,S1,L1);
|
||||
RGBToHSL(R2,g2,b2,H2,S2,L2);
|
||||
Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function ColorSame(var CTS,Tolerance : Integer; var R1,B1,G1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline;
|
||||
var
|
||||
H2,S2,L2 : extended;
|
||||
begin
|
||||
Result := False;
|
||||
case CTS of
|
||||
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
|
||||
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
|
||||
2: begin
|
||||
RGBToHSL(R1,g1,b1,H1,S1,L1);
|
||||
RGBToHSL(R2,g2,b2,H2,S2,L2);
|
||||
Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer);
|
||||
begin
|
||||
CachedWidth := NewWidth;
|
||||
CachedHeight := NewHeight;
|
||||
SetLength(ClientTPA,NewWidth * NewHeight);
|
||||
end;
|
||||
|
||||
procedure TMFinder.DefaultOperations(var x1, y1, x2, y2: integer);
|
||||
var
|
||||
w,h : integer;
|
||||
begin
|
||||
{ if x1 > x2 then
|
||||
Swap(x1,x2);
|
||||
if y1 > y2 then
|
||||
Swap(y1,y2);}
|
||||
if x1 < 0 then
|
||||
// x1 := 0;
|
||||
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
|
||||
'correct x1: %d.', [x1]);
|
||||
if y1 < 0 then
|
||||
// y1 := 0;
|
||||
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
|
||||
'correct y1: %d.', [y1]);
|
||||
|
||||
TClient(Self.Client).MWindow.GetDimensions(w,h);
|
||||
if (w <> CachedWidth) or (h <> CachedHeight) then
|
||||
UpdateCachedValues(w,h);
|
||||
if x2 >= w then
|
||||
// x2 := w-1;
|
||||
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
|
||||
'correct x2: %d.', [x2]);
|
||||
if y2 >= h then
|
||||
// y2 := h-1;
|
||||
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
|
||||
'correct y2: %d.', [y2]);
|
||||
end;
|
||||
|
||||
function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
clR, clG, clB : byte;
|
||||
dX, dY, xx, yy: Integer;
|
||||
h,s,l,hmod,smod : extended;
|
||||
Ccts : integer;
|
||||
begin
|
||||
DefaultOperations(xs, ys, xe, ye);
|
||||
dX := xe - xs;
|
||||
dY := ye - ys;
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
CCts := Self.CTS;
|
||||
result := 0;
|
||||
if cts = 2 then
|
||||
begin;
|
||||
RGBToHSL(clR,clG,clB,h,s,l);
|
||||
hmod := Self.hueMod;
|
||||
smod := Self.satMod;
|
||||
end;
|
||||
for yy := ys to ye do
|
||||
begin;
|
||||
for xx := xs to xe do
|
||||
begin;
|
||||
if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then
|
||||
inc(result);
|
||||
Inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc)
|
||||
end;
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy: Integer;
|
||||
|
||||
begin
|
||||
|
||||
// checks for valid x1,y1,x2,y2? (may involve GetDimensions)
|
||||
DefaultOperations(x1,y1,x2,y2);
|
||||
|
||||
// calculate delta x and y
|
||||
dX := x2 - x1;
|
||||
dY := y2 - y1;
|
||||
|
||||
//next, convert the color to r,g,b
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
|
||||
|
||||
// Do we want to "cache" these vars?
|
||||
// We will, for now. Easier to type.
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
|
||||
for yy := y1 to y2 do
|
||||
begin;
|
||||
for xx := x1 to x2 do
|
||||
begin;
|
||||
// Colour comparison here. Possibly with tolerance? ;)
|
||||
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
|
||||
begin
|
||||
Result := True;
|
||||
x := xx;
|
||||
y := yy;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
Exit;
|
||||
end;
|
||||
Inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc)
|
||||
end;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy: Integer;
|
||||
H1, S1, L1, H2, S2, L2: Extended;
|
||||
|
||||
label Hit;
|
||||
label Miss;
|
||||
|
||||
begin
|
||||
|
||||
// checks for valid x1,y1,x2,y2? (may involve GetDimensions)
|
||||
DefaultOperations(x1,y1,x2,y2);
|
||||
|
||||
// calculate delta x and y
|
||||
dX := x2 - x1;
|
||||
dY := y2 - y1;
|
||||
//next, convert the color to r,g,b
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
ColorToHSL(Color, H1, S1, L1);
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
|
||||
|
||||
// Do we want to "cache" these vars?
|
||||
// We will, for now. Easier to type.
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
|
||||
case CTS of
|
||||
0:
|
||||
for yy := y1 to y2 do
|
||||
begin
|
||||
for xx := x1 to x2 do
|
||||
begin
|
||||
if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then
|
||||
goto Hit;
|
||||
inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
|
||||
1:
|
||||
begin
|
||||
Tol := Sqr(Tol);
|
||||
|
||||
for yy := y1 to y2 do
|
||||
begin
|
||||
for xx := x1 to x2 do
|
||||
begin
|
||||
if (sqr(clB - Ptr^.B) + sqr(clG - Ptr^.G) + sqr(clR-Ptr^.R)) <= Tol then
|
||||
goto Hit;
|
||||
inc(ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
for yy := y1 to y2 do
|
||||
for xx := x1 to x2 do
|
||||
begin
|
||||
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
|
||||
if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then
|
||||
goto Hit;
|
||||
inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
end;
|
||||
Result := False;
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
Exit;
|
||||
|
||||
Hit:
|
||||
Result := True;
|
||||
x := xx;
|
||||
y := yy;
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColorsTolerance(var Points: TPointArray; Color, xs, ys,
|
||||
xe, ye, Tol: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc,C: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy: Integer;
|
||||
H1, S1, L1, H2, S2, L2: Extended;
|
||||
begin
|
||||
DefaultOperations(xs,ys,xe,ye);
|
||||
|
||||
dX := xe - xs;
|
||||
dY := ye - ys;
|
||||
//next, convert the color to r,g,b
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
ColorToHSL(Color, H1, S1, L1);
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
|
||||
|
||||
// Do we want to "cache" these vars?
|
||||
// We will, for now. Easier to type.
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
c := 0;
|
||||
case CTS of
|
||||
0:
|
||||
for yy := ys to ye do
|
||||
begin
|
||||
for xx := xs to xe do
|
||||
begin
|
||||
if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then
|
||||
begin;
|
||||
ClientTPA[c].x := xx;
|
||||
ClientTPA[c].y := yy;
|
||||
inc(c);
|
||||
end;
|
||||
inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
|
||||
1:
|
||||
for yy := ys to ye do
|
||||
begin
|
||||
for xx := xs to xe do
|
||||
begin
|
||||
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
|
||||
begin;
|
||||
ClientTPA[c].x := xx;
|
||||
ClientTPA[c].y := yy;
|
||||
inc(c);
|
||||
end;
|
||||
inc(ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
for yy := ys to ye do
|
||||
for xx := xs to xe do
|
||||
begin
|
||||
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
|
||||
if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then
|
||||
begin;
|
||||
ClientTPA[c].x := xx;
|
||||
ClientTPA[c].y := yy;
|
||||
inc(c);
|
||||
end;
|
||||
inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
end;
|
||||
SetLength(Points, C);
|
||||
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
|
||||
Result := C > 0;
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy, i: Integer;
|
||||
|
||||
begin
|
||||
DefaultOperations(x1,y1,x2,y2);
|
||||
|
||||
dX := x2 - x1;
|
||||
dY := y2 - y1;
|
||||
|
||||
I := 0;
|
||||
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
|
||||
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
|
||||
for yy := y1 to y2 do
|
||||
begin;
|
||||
for xx := x1 to x2 do
|
||||
begin;
|
||||
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
|
||||
begin
|
||||
Self.ClientTPA[I].x := xx;
|
||||
Self.ClientTPA[i].y := yy;
|
||||
Inc(I);
|
||||
end;
|
||||
Inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc);
|
||||
end;
|
||||
|
||||
SetLength(TPA, I);
|
||||
|
||||
Move(ClientTPA[0], TPA[0], i * SizeOf(TPoint));
|
||||
|
||||
Result := I > 0;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user