moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-08-13 16:53:59 -04:00
Code Issues Releases Wiki Activity

Resolving #68 in both branches...

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@444 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
BenLand100 2010-01-21 20:51:55 +00:00
parent 325c61374d
commit ac40880d4f
26 changed files with 341 additions and 1840 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
branches/iomanager/Projects/SAMufasaGUI/Makefile
View File

@ -31,5 +31,3 @@ clean:
$(binary):
$(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) project1.lpr
-Fu/usr/local/share/lazarus/ideintf/units/x86_64-linux/

4
branches/iomanager/Projects/SAMufasaGUI/debugimage.lrs
View File

@ -1,5 +1,3 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TDebugImgForm','FORMDATA',[
'TPF0'#13'TDebugImgForm'#12'DebugImgForm'#4'Left'#3#235#1#6'Height'#3','#1#3
+'Top'#3#10#1#5'Width'#3#144#1#11'BorderIcons'#11#12'biSystemMenu'#10'biMinim'
@ -8,4 +6,4 @@ LazarusResources.Add('TDebugImgForm','FORMDATA',[
+'OnHide'#7#8'FormHide'#8'OnResize'#7#10'FormResize'#10'LCLVersion'#6#6'0.9.2'
+'9'#0#6'TImage'#9'DrawImage'#4'Left'#2#0#6'Height'#3','#1#3'Top'#2#0#5'Width'
+#3#144#1#5'Align'#7#8'alClient'#0#0#0
]);
]);

2
branches/iomanager/Projects/SAMufasaGUI/debugimage.pas
View File

@ -59,7 +59,7 @@ var
implementation
uses
MufasaTypes, math, graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
MufasaTypes, math,windowutil,graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
{ TDebugImgForm }
procedure TDebugImgForm.FormCreate(Sender: TObject);

344
branches/iomanager/Projects/SAMufasaGUI/project1.lpi
View File

@ -10,7 +10,7 @@
<TargetFileExt Value=""/>
<Title Value="Simba"/>
<UseXPManifest Value="True"/>
<ActiveEditorIndexAtStart Value="11"/>
<ActiveEditorIndexAtStart Value="2"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
@ -24,7 +24,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="$(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
@ -36,16 +36,14 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="288">
<Units Count="284">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<CursorPos X="12" Y="25"/>
<TopLine Value="15"/>
<EditorIndex Value="7"/>
<CursorPos X="34" Y="35"/>
<TopLine Value="19"/>
<UsageCount Value="205"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
@ -140,9 +138,9 @@
<ResourceBaseClass Value="Form"/>
<UnitName Value="TestUnit"/>
<ComponentState Value="1"/>
<CursorPos X="74" Y="536"/>
<TopLine Value="515"/>
<EditorIndex Value="11"/>
<CursorPos X="12" Y="312"/>
<TopLine Value="290"/>
<EditorIndex Value="0"/>
<UsageCount Value="202"/>
<Loaded Value="True"/>
</Unit13>
@ -190,18 +188,16 @@
<Filename Value="../../Units/MMLCore/client.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Client"/>
<CursorPos X="46" Y="60"/>
<TopLine Value="43"/>
<EditorIndex Value="0"/>
<CursorPos X="35" Y="64"/>
<TopLine Value="46"/>
<UsageCount Value="201"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<Filename Value="../../Units/MMLCore/mufasatypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="MufasaTypes"/>
<CursorPos X="21" Y="33"/>
<TopLine Value="15"/>
<CursorPos X="39" Y="120"/>
<TopLine Value="98"/>
<EditorIndex Value="3"/>
<UsageCount Value="201"/>
<Loaded Value="True"/>
@ -218,8 +214,8 @@
<Filename Value="../../Units/MMLCore/window.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Window"/>
<CursorPos X="1" Y="163"/>
<TopLine Value="541"/>
<CursorPos X="71" Y="29"/>
<TopLine Value="363"/>
<UsageCount Value="201"/>
</Unit23>
<Unit24>
@ -232,24 +228,26 @@
<Unit25>
<Filename Value="../../Units/MMLCore/windowutil.pas"/>
<UnitName Value="windowutil"/>
<CursorPos X="1" Y="27"/>
<TopLine Value="12"/>
<UsageCount Value="100"/>
<CursorPos X="14" Y="16"/>
<TopLine Value="1"/>
<UsageCount Value="96"/>
</Unit25>
<Unit26>
<Filename Value="../../Units/MMLCore/input.pas"/>
<UnitName Value="Input"/>
<CursorPos X="1" Y="83"/>
<TopLine Value="56"/>
<UsageCount Value="93"/>
<CursorPos X="17" Y="286"/>
<TopLine Value="266"/>
<UsageCount Value="85"/>
</Unit26>
<Unit27>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="finder"/>
<CursorPos X="10" Y="2000"/>
<TopLine Value="1972"/>
<CursorPos X="9" Y="90"/>
<TopLine Value="86"/>
<EditorIndex Value="10"/>
<UsageCount Value="201"/>
<Loaded Value="True"/>
</Unit27>
<Unit28>
<Filename Value="../../../lazarus/lcl/graphics.pp"/>
@ -269,9 +267,9 @@
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mmlpsthread"/>
<CursorPos X="95" Y="114"/>
<TopLine Value="97"/>
<EditorIndex Value="1"/>
<CursorPos X="25" Y="34"/>
<TopLine Value="23"/>
<EditorIndex Value="4"/>
<UsageCount Value="202"/>
<Loaded Value="True"/>
</Unit30>
@ -351,9 +349,11 @@
<Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="bitmaps"/>
<CursorPos X="85" Y="113"/>
<TopLine Value="94"/>
<CursorPos X="50" Y="119"/>
<TopLine Value="113"/>
<EditorIndex Value="9"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit42>
<Unit43>
<Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.pp"/>
@ -364,9 +364,11 @@
</Unit43>
<Unit44>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/colour.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="34"/>
<CursorPos X="47" Y="47"/>
<TopLine Value="47"/>
<EditorIndex Value="8"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit44>
<Unit45>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/bitmap.inc"/>
@ -485,22 +487,24 @@
<IsPartOfProject Value="True"/>
<UnitName Value="colour_conv"/>
<CursorPos X="1" Y="332"/>
<TopLine Value="290"/>
<TopLine Value="302"/>
<EditorIndex Value="11"/>
<UsageCount Value="201"/>
<Loaded Value="True"/>
</Unit62>
<Unit63>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/mouse.inc"/>
<CursorPos X="11" Y="26"/>
<TopLine Value="12"/>
<EditorIndex Value="6"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
<CursorPos X="67" Y="48"/>
<TopLine Value="31"/>
<UsageCount Value="6"/>
</Unit63>
<Unit64>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="90"/>
<UsageCount Value="45"/>
<CursorPos X="53" Y="13"/>
<TopLine Value="75"/>
<EditorIndex Value="6"/>
<UsageCount Value="41"/>
<Loaded Value="True"/>
</Unit64>
<Unit65>
<Filename Value="../../Units/PascalScript/uPSCompiler.pas"/>
@ -538,9 +542,9 @@
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="plugins"/>
<CursorPos X="40" Y="132"/>
<TopLine Value="132"/>
<EditorIndex Value="4"/>
<CursorPos X="12" Y="54"/>
<TopLine Value="34"/>
<EditorIndex Value="1"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit70>
@ -602,8 +606,8 @@
<Filename Value="../../Units/MMLAddon/colourpicker.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="colourpicker"/>
<CursorPos X="22" Y="229"/>
<TopLine Value="217"/>
<CursorPos X="22" Y="228"/>
<TopLine Value="1"/>
<UsageCount Value="201"/>
</Unit79>
<Unit80>
@ -627,11 +631,9 @@
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="windowselector"/>
<CursorPos X="37" Y="34"/>
<TopLine Value="12"/>
<EditorIndex Value="9"/>
<CursorPos X="54" Y="139"/>
<TopLine Value="116"/>
<UsageCount Value="201"/>
<Loaded Value="True"/>
</Unit82>
<Unit83>
<Filename Value="../../../usr/lib64/fpc/2.2.4/source/rtl/objpas/classes/classesh.inc"/>
@ -714,8 +716,8 @@
<Filename Value="../../Units/MMLCore/ocr.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ocr"/>
<CursorPos X="51" Y="474"/>
<TopLine Value="457"/>
<CursorPos X="73" Y="142"/>
<TopLine Value="142"/>
<UsageCount Value="200"/>
</Unit94>
<Unit95>
@ -1199,11 +1201,10 @@
<ComponentName Value="ColourHistoryForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="colourhistory"/>
<CursorPos X="7" Y="73"/>
<TopLine Value="55"/>
<EditorIndex Value="8"/>
<ComponentState Value="1"/>
<CursorPos X="43" Y="16"/>
<TopLine Value="1"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit166>
<Unit167>
<Filename Value="../../../Documents/lazarus/lcl/comctrls.pp"/>
@ -1316,9 +1317,9 @@
<Unit183>
<Filename Value="../../Units/MMLCore/mmlkeyinput.pas"/>
<UnitName Value="MMLKeyInput"/>
<CursorPos X="36" Y="35"/>
<TopLine Value="23"/>
<UsageCount Value="15"/>
<CursorPos X="62" Y="31"/>
<TopLine Value="40"/>
<UsageCount Value="8"/>
</Unit183>
<Unit184>
<Filename Value="../../../Documents/lazarus/components/mouseandkeyinput/xkeyinput.pas"/>
@ -1370,11 +1371,9 @@
</Unit190>
<Unit191>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/keyboard.inc"/>
<CursorPos X="26" Y="43"/>
<TopLine Value="13"/>
<EditorIndex Value="5"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
<CursorPos X="13" Y="46"/>
<TopLine Value="26"/>
<UsageCount Value="2"/>
</Unit191>
<Unit192>
<Filename Value="../../../Documents/fpc/packages/x11/src/xlib.pp"/>
@ -1486,11 +1485,9 @@
<ComponentName Value="DebugImgForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="debugimage"/>
<CursorPos X="1" Y="1"/>
<CursorPos X="66" Y="17"/>
<TopLine Value="1"/>
<EditorIndex Value="10"/>
<UsageCount Value="202"/>
<Loaded Value="True"/>
</Unit207>
<Unit208>
<Filename Value="debugimage.lrs"/>
@ -1596,9 +1593,10 @@
<ComponentName Value="FunctionListFrame"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="framefunctionlist"/>
<ComponentState Value="1"/>
<CursorPos X="26" Y="295"/>
<TopLine Value="7"/>
<UsageCount Value="165"/>
<UsageCount Value="141"/>
</Unit223>
<Unit224>
<Filename Value="../../../usr/local/share/lazarus/lcl/comctrls.pp"/>
@ -1653,7 +1651,7 @@
<UnitName Value="simpleanalyzer"/>
<CursorPos X="52" Y="104"/>
<TopLine Value="193"/>
<UsageCount Value="152"/>
<UsageCount Value="128"/>
</Unit231>
<Unit232>
<Filename Value="../../Units/Misc/mPasLex.pas"/>
@ -1711,9 +1709,11 @@
</Unit239>
<Unit240>
<Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/>
<CursorPos X="25" Y="163"/>
<TopLine Value="154"/>
<UsageCount Value="23"/>
<CursorPos X="30" Y="109"/>
<TopLine Value="98"/>
<EditorIndex Value="7"/>
<UsageCount Value="19"/>
<Loaded Value="True"/>
</Unit240>
<Unit241>
<Filename Value="../../Units/Synapse/synautil.pas"/>
@ -1728,7 +1728,7 @@
<UnitName Value="updater"/>
<CursorPos X="38" Y="211"/>
<TopLine Value="65"/>
<UsageCount Value="125"/>
<UsageCount Value="101"/>
</Unit242>
<Unit243>
<Filename Value="updateform.pas"/>
@ -1736,10 +1736,11 @@
<ComponentName Value="SimbaUpdateForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="updateform"/>
<ComponentState Value="1"/>
<CursorPos X="111" Y="102"/>
<TopLine Value="207"/>
<UsageCount Value="120"/>
<TopLine Value="81"/>
<EditorIndex Value="5"/>
<UsageCount Value="96"/>
<Loaded Value="True"/>
</Unit243>
<Unit244>
<Filename Value="../../../Documents/lazarus/lcl/fileutil.pas"/>
@ -1860,7 +1861,7 @@
<UnitName Value="simbasettings"/>
<CursorPos X="26" Y="9"/>
<TopLine Value="11"/>
<UsageCount Value="83"/>
<UsageCount Value="59"/>
</Unit261>
<Unit262>
<Filename Value="../../Units/MMLAddon/settings.pas"/>
@ -1903,9 +1904,10 @@
<ComponentName Value="FormReportBug"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="reportbug"/>
<ComponentState Value="1"/>
<CursorPos X="53" Y="23"/>
<TopLine Value="21"/>
<UsageCount Value="66"/>
<UsageCount Value="42"/>
</Unit267>
<Unit268>
<Filename Value="../../Units/Synapse/synsock.pas"/>
@ -1962,7 +1964,7 @@
<UnitName Value="newinternets"/>
<CursorPos X="80" Y="2"/>
<TopLine Value="1"/>
<UsageCount Value="62"/>
<UsageCount Value="38"/>
</Unit275>
<Unit276>
<Filename Value="reportbug.lrs"/>
@ -2006,175 +2008,135 @@
<UsageCount Value="15"/>
</Unit281>
<Unit282>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<UnitName Value="IOManager"/>
<CursorPos X="43" Y="529"/>
<TopLine Value="516"/>
<Filename Value="../../Units/MMLCore/libloader.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="libloader"/>
<CursorPos X="20" Y="3"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="22"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit282>
<Unit283>
<Filename Value="../../Units/MMLCore/os_linux.pas"/>
<UnitName Value="os_linux"/>
<CursorPos X="5" Y="21"/>
<TopLine Value="1"/>
<EditorIndex Value="13"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
<Filename Value="../../../../../custom-installs/freepascal/rtl/objpas/classes/classesh.inc"/>
<CursorPos X="15" Y="1506"/>
<TopLine Value="1478"/>
<UsageCount Value="10"/>
</Unit283>
<Unit284>
<Filename Value="../../../../custom-installs/freepascal/rtl/unix/mouse.pp"/>
<UnitName Value="Mouse"/>
<CursorPos X="21" Y="30"/>
<TopLine Value="12"/>
<UsageCount Value="12"/>
</Unit284>
<Unit285>
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
<UnitName Value="os_windows"/>
<CursorPos X="4" Y="21"/>
<TopLine Value="1"/>
<EditorIndex Value="12"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit285>
<Unit286>
<Filename Value="../../../../../../../../usr/local/share/lazarus/components/mouseandkeyinput/xkeyinput.pas"/>
<UnitName Value="XKeyInput"/>
<CursorPos X="19" Y="19"/>
<TopLine Value="164"/>
<UsageCount Value="10"/>
</Unit286>
<Unit287>
<Filename Value="../../Units/Linux/xinput.pas"/>
<UnitName Value="xinput"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit287>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<JumpHistory Count="28" HistoryIndex="27">
<Position1>
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
<Caret Line="174" Column="24" TopLine="155"/>
<Filename Value="testunit.pas"/>
<Caret Line="1452" Column="33" TopLine="1439"/>
</Position1>
<Position2>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="486" Column="36" TopLine="461"/>
<Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/>
<Caret Line="115" Column="17" TopLine="80"/>
</Position2>
<Position3>
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
<Caret Line="181" Column="48" TopLine="156"/>
<Filename Value="../../Units/MMLCore/colour_conv.pas"/>
<Caret Line="48" Column="1" TopLine="4"/>
</Position3>
<Position4>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="179" Column="68" TopLine="166"/>
<Filename Value="../../Units/MMLCore/colour_conv.pas"/>
<Caret Line="351" Column="52" TopLine="346"/>
</Position4>
<Position5>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="157" Column="30" TopLine="141"/>
<Filename Value="../../Units/MMLCore/colour_conv.pas"/>
<Caret Line="374" Column="5" TopLine="345"/>
</Position5>
<Position6>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="178" Column="47" TopLine="7"/>
<Filename Value="../../Units/MMLCore/colour_conv.pas"/>
<Caret Line="364" Column="35" TopLine="345"/>
</Position6>
<Position7>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="29" Column="90" TopLine="1"/>
<Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/>
<Caret Line="119" Column="77" TopLine="80"/>
</Position7>
<Position8>
<Filename Value="testunit.pas"/>
<Caret Line="1792" Column="84" TopLine="1789"/>
<Caret Line="1449" Column="100" TopLine="1439"/>
</Position8>
<Position9>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="480" Column="16" TopLine="465"/>
<Filename Value="testunit.pas"/>
<Caret Line="1489" Column="3" TopLine="1487"/>
</Position9>
<Position10>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="481" Column="19" TopLine="464"/>
<Filename Value="testunit.pas"/>
<Caret Line="474" Column="10" TopLine="459"/>
</Position10>
<Position11>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="475" Column="15" TopLine="458"/>
<Filename Value="testunit.pas"/>
<Caret Line="434" Column="20" TopLine="391"/>
</Position11>
<Position12>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="497" Column="48" TopLine="486"/>
<Filename Value="testunit.pas"/>
<Caret Line="533" Column="40" TopLine="508"/>
</Position12>
<Position13>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="441" Column="22" TopLine="424"/>
<Filename Value="testunit.pas"/>
<Caret Line="58" Column="21" TopLine="38"/>
</Position13>
<Position14>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="564" Column="7" TopLine="550"/>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<Caret Line="128" Column="27" TopLine="111"/>
</Position14>
<Position15>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="574" Column="76" TopLine="551"/>
<Filename Value="testunit.pas"/>
<Caret Line="468" Column="17" TopLine="418"/>
</Position15>
<Position16>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="546" Column="17" TopLine="529"/>
<Filename Value="testunit.pas"/>
<Caret Line="1017" Column="63" TopLine="1010"/>
</Position16>
<Position17>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="549" Column="16" TopLine="532"/>
<Filename Value="../../Units/MMLCore/libloader.pas"/>
<Caret Line="21" Column="6" TopLine="1"/>
</Position17>
<Position18>
<Filename Value="testunit.pas"/>
<Caret Line="566" Column="18" TopLine="551"/>
<Filename Value="../../Units/MMLCore/mufasatypes.pas"/>
<Caret Line="32" Column="31" TopLine="1"/>
</Position18>
<Position19>
<Filename Value="testunit.pas"/>
<Caret Line="560" Column="69" TopLine="551"/>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="291" Column="29" TopLine="274"/>
</Position19>
<Position20>
<Filename Value="testunit.pas"/>
<Caret Line="564" Column="41" TopLine="551"/>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="329" Column="31" TopLine="312"/>
</Position20>
<Position21>
<Filename Value="testunit.pas"/>
<Caret Line="566" Column="18" TopLine="551"/>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="330" Column="41" TopLine="313"/>
</Position21>
<Position22>
<Filename Value="testunit.pas"/>
<Caret Line="567" Column="18" TopLine="551"/>
<Caret Line="308" Column="33" TopLine="292"/>
</Position22>
<Position23>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="216" Column="18" TopLine="206"/>
<Filename Value="testunit.pas"/>
<Caret Line="604" Column="21" TopLine="581"/>
</Position23>
<Position24>
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
<Caret Line="69" Column="31" TopLine="56"/>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="122" Column="11" TopLine="109"/>
</Position24>
<Position25>
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
<Caret Line="247" Column="52" TopLine="234"/>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="89" Column="30" TopLine="77"/>
</Position25>
<Position26>
<Filename Value="../../Units/MMLCore/client.pas"/>
<Caret Line="64" Column="43" TopLine="45"/>
<Filename Value="testunit.pas"/>
<Caret Line="604" Column="21" TopLine="537"/>
</Position26>
<Position27>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="328" Column="27" TopLine="96"/>
<Filename Value="testunit.pas"/>
<Caret Line="312" Column="27" TopLine="289"/>
</Position27>
<Position28>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="217" Column="137" TopLine="200"/>
</Position28>
<Position29>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="213" Column="28" TopLine="185"/>
</Position29>
<Position30>
<Filename Value="testunit.pas"/>
<Caret Line="558" Column="20" TopLine="573"/>
</Position30>
<Caret Line="355" Column="12" TopLine="338"/>
</Position28>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
@ -2185,22 +2147,14 @@
<SearchPaths>
<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/;$(ProjPath)../../Units/Linux/;$(ProjPath)../../Units/Synapse/;$(LazarusDir)/components/mouseandkeyinput/"/>
<UnitOutputDirectory Value="$(ProjPath)../../build/$(TargetOS)"/>
<UnitOutputDirectory Value="../../build/$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<TargetOS Value="Linux"/>
<Optimizations>
<VariablesInRegisters Value="True"/>
<OptimizationLevel Value="2"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dUseCThreads
-dM_MEMORY_DEBUG

10
branches/iomanager/Projects/SAMufasaGUI/project1.lpr
View File

@ -29,12 +29,14 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cmem,
{$ENDIF}{$ENDIF}
Interfaces, Forms, testunit, colourhistory, About, internets, debugimage,
framefunctionlist, simpleanalyzer, updater, updateform, simbasettings;
{$R project1.res}
Interfaces, // this includes the LCL widgetset
LResources, Forms, testunit, colourhistory, About, internets, debugimage,
framefunctionlist, simpleanalyzer, updater, updateform, simbasettings,
libloader;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
begin
{$I project1.lrs}
Application.Title:='Simba';
Application.Initialize;

46
branches/iomanager/Projects/SAMufasaGUI/testunit.pas
View File

@ -33,14 +33,13 @@ uses
{$ifdef linux}cthreads,{$endif}Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Menus, ComCtrls, ExtCtrls, SynEdit, SynHighlighterPas, SynMemo,
//Client,
MufasaTypes,
MufasaTypes, plugins,
mmlpsthread,synedittypes,
{$IFDEF MSWINDOWS} os_windows, {$ENDIF} //For ColorPicker etc.
{$IFDEF LINUX} os_linux, {$ENDIF} //For ColorPicker etc.
window, // for the comp picker and selector
colourpicker, framescript, windowselector, lcltype, ActnList, StdActns,
SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynEditMarkupSpecialLine,
SynEditMarkupHighAll, SynEditMiscClasses, LMessages, Buttons, PairSplitter,
ColorBox , about, framefunctionlist, ocr, updateform, simbasettings;
ColorBox, about, framefunctionlist, ocr, updateform, simbasettings;
const
SimbaVersion = 429;
@ -306,10 +305,11 @@ type
CurrScript : TScriptFrame; //The current scriptframe
CurrTab : TMufasaTab; //The current TMufasaTab
Tabs : TList;
Manager: TIOManager;
Window: TMWindow;
OCR_Fonts: TMOCR;
Picker: TMColorPicker;
Selector: TMWindowSelector;
PluginsGlob: TMPlugins;
procedure FunctionListShown( ShowIt : boolean);
property ScriptState : TScriptState read GetScriptState write SetScriptState;
procedure SafeCallThread;
@ -352,7 +352,7 @@ var
implementation
uses
lclintf,plugins,
lclintf,
syncobjs, // for the critical sections
debugimage,
bitmaps,
@ -527,13 +527,9 @@ begin
Writeln('The script hasn''t stopped yet, so we cannot start a new one.');
exit;
end;
AppPath:= MainDir + DS;
includePath:= LoadSettingDef('Settings/Includes/Path', IncludeTrailingPathDelimiter(ExpandFileName(MainDir+ DS + '..' + DS + '..' + ds)) + 'Includes' + DS);
fontPath := LoadSettingDef('Settings/Fonts/Path', IncludeTrailingPathDelimiter(ExpandFileName(MainDir+ DS + '..' + DS + '..' + ds)) + 'Fonts' + DS);
PluginsPath := LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
ScriptErrorLine:= -1;
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
ScriptThread := TMMLPSThread.Create(True,@CurrentSyncInfo,PluginsPath);
ScriptThread := TMMLPSThread.Create(True,@CurrentSyncInfo);
{$IFNDEF TERMINALWRITELN}
ScriptThread.SetDebug(@formWriteln);
ScriptThread.DebugMemo := Self.Memo1;
@ -551,6 +547,16 @@ begin
if ScriptFile <> '' then
ScriptPath := ExtractFileDir(ScriptFile);
AppPath:= MainDir + DS;
includePath:= LoadSettingDef('Settings/Includes/Path',
IncludeTrailingPathDelimiter(ExpandFileName(MainDir+
DS + '..' + DS + '..' + ds)) + 'Includes' + DS);
fontPath := LoadSettingDef('Settings/Fonts/Path',
IncludeTrailingPathDelimiter(ExpandFileName(MainDir+
DS + '..' + DS + '..' + ds)) + 'Fonts' + DS);
PluginsPath := LoadSettingDef('Settings/Plugins/Path',
ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
if not DirectoryExists(PluginsPath) and not assigned(PluginsGlob) then
begin
if FirstRun then
@ -568,7 +574,9 @@ begin
Writeln('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now');
ScriptThread.SetPaths(ScriptPath,AppPath,Includepath,PluginsPath,fontPath);
if selector.haspicked then ScriptThread.Client.IOManager.SetTarget(Selector.LastPick);
// This doesn't actually set the Client's MWindow to the passed window, it
// only copies the current set window handle.
ScriptThread.Client.MWindow.SetWindow(Self.Window);
loadFontsOnScriptStart := LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True');
@ -1264,9 +1272,9 @@ begin
Tabs := TList.Create;
AddTab;//Give it alteast 1 tab ;-).
FunctionListShown(True); //Show this function list bitch!
Manager := TIOManager.Create(''); //No need to load plugins for the Global manager
Picker := TMColorPicker.Create(Manager);
Selector := TMWindowSelector.Create(Manager);
Window := TMWindow.Create;
Picker := TMColorPicker.Create(Window);
Selector := TMWindowSelector.Create(Window);
MainDir:= ExtractFileDir(Application.ExeName);
{ For writeln }
SetLength(DebugStream, 0);
@ -1295,7 +1303,7 @@ begin
Tabs.free;
Selector.Free;
Picker.Free;
Manager.Free;
Window.Free;
PluginsGlob.Free;
SetLength(DebugStream, 0);
@ -1480,7 +1488,7 @@ end;
procedure TForm1.MenuItemReportBugClick(Sender: TObject);
begin
//OpenURL('http://old.villavu.com/mantis/bug_report_page.php');
OpenURL('http://old.villavu.com/mantis/bug_report_page.php');
end;
procedure TForm1.MenuItemShowClick(Sender: TObject);
@ -1539,8 +1547,8 @@ end;
procedure TForm1.ButtonSelectorDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Manager.SetTarget(Selector.Drag);
writeln('New window: ' + IntToStr(Selector.LastPick));
Window.SetTarget(Selector.Drag {$ifdef MSWINDOWS},w_window{$endif});
writeln('New window: ' + IntToStr(Window.{$ifdef MSWindows}TargetHandle{$else}CurWindow{$ENDIF}));
end;
procedure TForm1.NoTray(Sender: TObject);

4
branches/iomanager/Units/MMLAddon/PSInc/Wrappers/bitmap.inc
View File

@ -151,13 +151,13 @@ end;
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
begin
CurrThread.Client.MBitmaps.GetBMP(bmp).CopyClientToBitmap(CurrThread.Client.IOManager, True, xs, ys, xe, ye);
CurrThread.Client.MBitmaps.GetBMP(bmp).CopyClientToBitmap(CurrThread.Client.MWindow, True, xs, ys, xe, ye);
end;
function BitmapFromClient(const xs, ys, xe, ye: Integer): Integer;
begin;
result := CurrThread.Client.MBitmaps.CreateBMP(0,0);
CurrThread.Client.MBitmaps.Bmp[result].CopyClientToBitmap(CurrThread.Client.IOManager,True,xs,ys,xe,ye);
CurrThread.Client.MBitmaps.Bmp[result].CopyClientToBitmap(CurrThread.Client.MWindow,True,xs,ys,xe,ye);
end;
function FindBitmap(Bitmap: integer; out x, y: Integer): Boolean;

2
branches/iomanager/Units/MMLAddon/PSInc/Wrappers/colour.inc
View File

@ -23,7 +23,7 @@
function GetColor(x,y : integer) : TColor;
begin;
Result := CurrThread.Client.IOManager.GetColor(x,y);
Result := CurrThread.Client.MWindow.GetColor(x,y);
end;
function findcolor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;

10
branches/iomanager/Units/MMLAddon/PSInc/Wrappers/keyboard.inc
View File

@ -23,25 +23,25 @@
procedure KeyDown(key: Word);
begin
CurrThread.Client.IOManager.KeyDown(key);
CurrThread.Client.MInput.KeyDown(key);
end;
procedure KeyUp(key: Word);
begin
CurrThread.Client.IOManager.KeyUp(key);
CurrThread.Client.MInput.KeyUp(key);
end;
procedure SendKeys(s: string);
begin
CurrThread.Client.IOManager.SendText(s);
CurrThread.Client.MInput.SendText(s);
end;
procedure PressKey(key: Word);
begin
CurrThread.Client.IOManager.PressKey(key);
CurrThread.Client.MInput.PressKey(key);
end;
function isKeyDown(key: Word): boolean;
begin
Result := CurrThread.Client.IOManager.isKeyDown(key);
Result := CurrThread.Client.MInput.isKeyDown(key);
end;

12
branches/iomanager/Units/MMLAddon/PSInc/Wrappers/mouse.inc
View File

@ -27,12 +27,12 @@ const
ps_mouse_middle = 2;
procedure MoveMouse(x, y: integer);
begin
CurrThread.Client.IOManager.SetMousePos(X, Y);
CurrThread.Client.MInput.SetMousePos(X, Y);
end;
procedure GetMousePos(out x, y: integer);
begin
CurrThread.Client.IOManager.GetMousePos(X, Y);
CurrThread.Client.MInput.GetMousePos(X, Y);
end;
function ConvIntClickType(Int : Integer) : TClickType;inline;
begin;
@ -47,15 +47,17 @@ end;
procedure HoldMouse(x, y: integer; clickType: integer);
begin
CurrThread.Client.IOManager.HoldMouse(x, y, ConvIntClickType(clickType));
CurrThread.Client.MInput.SetMousePos(x, y);
CurrThread.Client.MInput.MouseButtonAction(x, y, ConvIntClickType(clickType), mouse_Down);
end;
procedure ReleaseMouse(x, y: integer; clickType: integer);
begin
CurrThread.Client.IOManager.ReleaseMouse(x, y, ConvIntClickType(clickType));
CurrThread.Client.MInput.SetMousePos(x, y);
CurrThread.Client.MInput.MouseButtonAction(x, y, ConvIntClickType(clickType), mouse_Up);
end;
procedure ClickMouse(x, y: integer; clickType: integer);
begin
CurrThread.Client.IOManager.ClickMouse(x, y, ConvIntClickType(clickType));
CurrThread.Client.MInput.ClickMouse(x, y, ConvIntClickType(clickType));
end;

4
branches/iomanager/Units/MMLAddon/PSInc/Wrappers/other.inc
View File

@ -53,9 +53,9 @@ var
w,h : integer;
bmp: TMufasaBitmap;
begin;
CurrThread.Client.IOManager.GetDimensions(w,h);
CurrThread.Client.MWindow.GetDimensions(w,h);
bmp := TMufasaBitmap.Create;
bmp.CopyClientToBitmap(CurrThread.Client.IOManager,True,0,0,w-1,h-1);
bmp.CopyClientToBitmap(CurrThread.Client.MWindow,True,0,0,w-1,h-1);
bmp.SaveToFile(FileName);
bmp.Free;
end;

16
branches/iomanager/Units/MMLAddon/PSInc/Wrappers/window.inc
View File

@ -23,38 +23,36 @@
procedure SetDesktopAsClient;
begin;
CurrThread.Client.IOManager.SetDesktop;
CurrThread.Client.MWindow.SetDesktop;
end;
procedure SetTargetBitmap(bitmap: Integer);
begin;
With CurrThread.Client do
IOManager.SetTarget(MBitmaps.Bmp[Bitmap]);
MWindow.SetTarget(MBitmaps.Bmp[Bitmap]);
end;
procedure GetClientDimensions(out w, h: integer);
begin
CurrThread.Client.IOManager.GetDimensions(w, h);
CurrThread.Client.MWindow.GetDimensions(w, h);
end;
function Freeze: boolean;
begin
CurrThread.Client.IOManager.SetFrozen(true);
result := true;
result := CurrThread.Client.MWindow.Freeze();
end;
function Unfreeze: boolean;
begin
CurrThread.Client.IOManager.SetFrozen(false);
result := true;
result := CurrThread.Client.MWindow.Unfreeze;
end;
procedure SetTargetArray(P: Integer; w, h: integer);
begin
CurrThread.Client.IOManager.SetTarget(PRGB32(P), classes.point(w,h));
CurrThread.Client.MWindow.SetTarget(PRGB32(P), classes.point(w,h));
end;
procedure activateclient;
begin
CurrThread.Client.IOManager.ActivateClient;
CurrThread.Client.MWindow.ActivateClient;
end;

1
branches/iomanager/Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -168,6 +168,7 @@ AddFunction(@KeyUp, 'procedure KeyUp(key: Word);');
AddFunction(@PressKey, 'procedure PressKey(key: Word);');
AddFunction(@SendKeys, 'procedure SendKeys(s: string);');
AddFunction(@isKeyDown, 'function IsKeyDown(key: Word): Boolean;');
AddFunction(@GetKeyCode, 'function GetKeyCode(Key : char) : byte');
{ OCR}
SetCurrSection('OCR');

30
branches/iomanager/Units/MMLAddon/colourpicker.pas
View File

@ -30,9 +30,7 @@ interface
uses
Classes, SysUtils, LCLIntf,LCLType,InterfaceBase,Forms,Controls,ExtCtrls,
Graphics,
{$IFDEF MSWINDOWS} os_windows, {$ENDIF}
{$IFDEF LINUX} os_linux, {$ENDIF}
MufasaTypes, colourhistory,bitmaps
Window,MufasaTypes, colourhistory,bitmaps,input
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
@ -46,7 +44,7 @@ type
TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);
TMColorPicker = class(TObject)
constructor Create(manager: TIOManager);
constructor Create(aWindow: TMWindow);
destructor Destroy; override;
procedure Pick(Out C, X, Y: Integer);
@ -55,7 +53,11 @@ type
procedure ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
public
manager: TIOManager;
// Will give us CopyClientToBitmap
Window: TMWindow;
// Created and freed in Pick.
Input: TMInput;
{ Form components }
ScreenForm, InfoForm : TForm;
@ -78,12 +80,12 @@ type
implementation
constructor TMColorPicker.Create(manager: TIOManager);
constructor TMColorPicker.Create(aWindow: TMWindow);
begin
inherited Create;
self.manager := manager;
Self.Window := aWindow;
end;
destructor TMColorPicker.Destroy;
@ -102,7 +104,7 @@ var
p : TPoint;
bmp: TMufasaBitmap;
Desktop : TIOManager;
Desktop : TMWindow;
begin
@ -110,11 +112,12 @@ begin
w := 0;
h := 0;
{ If the target window isn't valid (closed etc), make the destkop the new window}
if not Self.Manager.TargetValid then
self.Manager.SetDesktop;
if not Self.Window.TargetValid then
self.Window.SetDesktop;
Input := TMInput.Create(Self.Window);//For the correct x,y values
{Desktop is needed for the whole picture}
Desktop := TIOManager.Create('');
Desktop := TMWindow.Create;
Desktop.SetDesktop;
Desktop.GetDimensions(w, h);
@ -210,6 +213,7 @@ begin
InfoForm.Free;
ScreenForm.Free;
Input.Free;
Desktop.free;
{ Re-enable the color pick buttons }
@ -226,7 +230,7 @@ var
MouseX, MouseY: Integer;
begin
{ Move the info form }
manager.GetMousePos(MouseX, MouseY);
Input.GetMousePos(MouseX, MouseY);
InfoForm.Left := Mouse.CursorPos.X + 5;
InfoForm.Top := Mouse.CursorPos.Y - 15;
@ -277,7 +281,7 @@ procedure TMColorPicker.ColorPickUp(Sender: TObject; Button: TMouseButton;
begin;
{ Set the coordinates and color that the user cliked on }
Color:= WidgetSet.DCGetPixel(ImageMain.Canvas.Handle,x,y);
Manager.GetMousePos(ColorX, ColorY);
Input.GetMousePos(ColorX, ColorY);
if OnPick <> nil then
Onpick(Sender,Color,Colorx,Colory);

12
branches/iomanager/Units/MMLAddon/mmlpsthread.pas
View File

@ -29,7 +29,9 @@ unit mmlpsthread;
interface
uses
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes, web,bitmaps;
Classes, SysUtils, client, uPSComponent, uPSCompiler,
uPSRuntime, stdCtrls, uPSPreProcessor, MufasaTypes,
web, bitmaps, plugins;
type
{ TMMLPSThread }
@ -86,6 +88,7 @@ type
//DebugTo : TMemo;
DebugTo: TWritelnProc;
DebugImg : TDbgImgInfo;
PluginsGlob: TMPlugins;
PluginsToload : Array of integer;
FOnError : TOnError;
procedure OnCompile(Sender: TPSScript);
@ -111,7 +114,7 @@ type
procedure SetDebug( writelnProc : TWritelnProc );
procedure SetDbgImg( DebugImageInfo : TDbgImgInfo);
procedure SetPaths(ScriptP,AppP,IncludeP,PluginP,FontP : string);
constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo);
destructor Destroy; override;
end;
threadvar
@ -129,6 +132,7 @@ uses
math, //Maths!
internets, // internets
strutils,
input,
tpa, //Tpa stuff
forms,//Forms
lclintf; // for GetTickCount and others.
@ -210,11 +214,11 @@ end;
}
constructor TMMLPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
constructor TMMLPSThread.Create(CreateSuspended : boolean; TheSyncInfo : PSyncInfo);
begin
SyncInfo:= TheSyncInfo;
SetLength(PluginsToLoad,0);
Client := TClient.Create(plugin_dir);
Client := TClient.Create;
PSScript := TPSScript.Create(nil);
PSScript.UsePreProcessor:= True;
PSScript.OnNeedFile := @RequireFile;

133
branches/iomanager/Units/MMLAddon/plugins.pas
View File

@ -34,7 +34,7 @@ unit plugins;
interface
uses
Classes, SysUtils, dynlibs;
Classes, SysUtils, dynlibs, LibLoader;
type
TMPluginMethod = record
@ -48,28 +48,6 @@ type
end;
TMPluginArray = array of TMPlugin;
TGenericLib = record
filename: string;
handle: TLibHandle;
end;
TGenericLibArray = array of TGenericLib;
TGenericLoader = class(TObject)
private
PluginLen : integer;
Loaded: TGenericLibArray;
procedure FreePlugins;
protected
function InitPlugin(plugin: TLibHandle): boolean; virtual; abstract;
public
PluginDirs : TStringList;
constructor Create;
destructor Destroy; override;
procedure ValidateDirs;
procedure LoadPluginsDir(DirIndex : integer);
function LoadPlugin(PluginName : string) : integer;
end;
{ TMPlugins }
@ -91,115 +69,6 @@ uses
{ TMPlugins }
procedure TGenericLoader.FreePlugins;
var
I : integer;
begin
for i := 0 to PluginLen - 1 do
begin;
if (Loaded[i].handle > 0) then
try
Writeln(inttostr(I));
FreeLibrary(Loaded[i].handle);
except
end;
end;
SetLength(Loaded,0);
PluginLen:= 0;
end;
procedure TGenericLoader.ValidateDirs;
var
i : integer;
TempStr : string;
begin
for i := 0 to PluginDirs.Count - 1 do
begin;
if DirectoryExists(PluginDirs.Strings[i]) = false then
raise Exception.createFMT('Directory(%s) does not exist',[PluginDirs[i]]);
TempStr := PluginDirs.Strings[i];
if (TempStr[Length(TempStr)] <> DS) then
begin;
if (TempStr[Length(TempStr)] = '\') or (TempStr[Length(TempStr)] = '/') then
TempStr[Length(TempStr)] := DS
else
TempStr := TempStr + DS;
PluginDirs.Strings[i] := TempStr;
end;
end;
end;
procedure TGenericLoader.LoadPluginsDir(DirIndex: integer);
var
PlugExt: String = {$IFDEF LINUX}'*.so';{$ELSE}'*.dll';{$ENDIF}
FileSearcher : TSearchRec;
begin
if (DirIndex < 0) or (DirIndex >= PluginDirs.Count) then
Exit;
if FindFirst(PluginDirs.Strings[DirIndex] + PlugExt, faAnyFile, FileSearcher) <> 0 then
begin;
FindClose(FileSearcher);
Exit;
end;
repeat
LoadPlugin(FileSearcher.Name);
until FindNext(FileSearcher) <> 0;
FindClose(FileSearcher);
end;
function TGenericLoader.LoadPlugin(PluginName: string): Integer;
var
i, ii : integer;
Status : LongInt;
PlugExt: String = {$IFDEF LINUX}'.so';{$ELSE}'.dll';{$ENDIF}
begin
ii := -1;
result := -1;
if PluginDirs.Count = 0 then
Exit;
ValidateDirs;
PluginName := ExtractFileNameWithoutExt(PluginName);
for i := 0 to PluginDirs.Count - 1 do
if FileExists(PluginDirs.Strings[i] + Pluginname + PlugExt) then
begin;
if ii <> -1 then
Raise Exception.CreateFmt('Plugin(%s) has been found multiple times',[PluginName]);
ii := i;
end;
if ii = -1 then
raise Exception.CreateFMT('Plugins(%s) has not been found',[PluginName]);
for i := 0 to PluginLen - 1 do
if Loaded[i].filename = (PluginDirs.Strings[ii] + PluginName + PlugExt) then
Exit(i);
SetLength(Loaded,PluginLen + 1);
Writeln(Format('Loading plugin %s at %s',[PluginName,PluginDirs.Strings[ii]]));
Loaded[PluginLen].filename:= PluginDirs.Strings[ii] + Pluginname + PlugExt;
Loaded[PluginLen].handle:= LoadLibrary(PChar(Loaded[PluginLen].filename));
if Loaded[PluginLen].handle = 0 then
Raise Exception.CreateFMT('Error loading plugin %s',[Loaded[PluginLen].filename]);
if InitPlugin(Loaded[PluginLen].handle) then
inc(PluginLen)
else
FreeLibrary(Loaded[PluginLen].handle);
Result := PluginLen;
end;
constructor TGenericLoader.Create;
begin
inherited Create;
PluginLen := 0;
PluginDirs := TStringList.Create;
end;
destructor TGenericLoader.Destroy;
begin
FreePlugins;
PluginDirs.Free;
inherited Destroy;
end;
function TMPlugins.InitPlugin(plugin: TLibHandle): boolean;
var
pntrArrc : function : integer; stdcall;

46
branches/iomanager/Units/MMLAddon/windowselector.pas
View File

@ -30,8 +30,7 @@ interface
uses
Classes, SysUtils,
ctypes,
{$IFDEF MSWINDOWS} os_windows, {$ENDIF}
{$IFDEF LINUX} os_linux, {$ENDIF}
window, windowutil,
controls,
graphics,
forms,
@ -44,16 +43,17 @@ uses
type
TMWindowSelector = class(TObject)
constructor Create(manager: TIOManager);
constructor Create(aWindow: TMWindow);
destructor Destroy; override;
function Drag: TNativeWindow;
{$IFDEF LINUX}
function Drag: x.TWindow;
{$ELSE}
function Drag: Hwnd;
{$ENDIF}
public
LastPick: TNativeWindow;
haspicked: boolean;
manager: TIOManager;
Window: TMWindow;
end;
@ -61,11 +61,11 @@ type
implementation
constructor TMWindowSelector.Create(manager: TIOManager);
constructor TMWindowSelector.Create(aWindow: TMWindow);
begin
inherited create;
haspicked:= false;
self.manager := manager;
Self.Window := aWindow;
end;
@ -77,7 +77,7 @@ begin
end;
{$IFDEF LINUX}
function TMWindowSelector.Drag: TNativeWindow;
function TMWindowSelector.Drag: x.TWindow;
var
Tempwindow : x.TWindow;
root : x.TWindow;
@ -96,13 +96,13 @@ begin
Result := 0;
window_opacity:=XInternAtom(manager.display,PChar('_NET_WM_WINDOW_OPACITY'), False);
window_opacity:=XInternAtom(Window.XDisplay,PChar('_NET_WM_WINDOW_OPACITY'), False);
opacity_75 := cuint($ffffffff * 0.75);
opacity_100 := cuint($ffffffff);
repeat
// get pointer pos + current window we are at.
XQueryPointer(manager.display, manager.desktop, @root,
XQueryPointer(Window.XDisplay, Window.DesktopWindow, @root,
@Tempwindow, @x_root, @y_root,
@x, @y, @xmask);
subwindow:= Tempwindow;
@ -110,7 +110,7 @@ begin
while subwindow <> 0 do
begin
Tempwindow := subwindow;
XQueryPointer(manager.display, Tempwindow, @root,
XQueryPointer(Window.XDisplay, Tempwindow, @root,
@subwindow, @x_root, @y_root,
@x, @y, @xmask);
end;
@ -120,19 +120,17 @@ begin
if Result <> Tempwindow then
begin
writeln('Making ' + inttostr(tempwindow) + ' transparent');
XChangeProperty(manager.display, tempwindow, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_75, 1);
XChangeProperty(Window.XDisplay, tempwindow, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_75, 1);
writeln('Resetting ' + inttostr(Result));
if result <> 0 then
XChangeProperty(manager.display, Result, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_100, 1);
XChangeProperty(Window.XDisplay, Result, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_100, 1);
WriteLn('Changing Window from: ' + Inttostr(result) +' to: ' + IntToStr(Tempwindow));
// XChangeProperty(Window.XDisplay, tempwindow, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_50, 1);
Result := Tempwindow;
LastPick:= TempWindow;
haspicked:= true;
end;
XFlush(manager.display);
XFlush(Window.XDisplay);
Sleep(16);
//if we are selecting for a long time, we must still process other messages
@ -140,15 +138,15 @@ begin
until (xmask and Button1Mask) = 0;
XChangeProperty(manager.display, Result, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_100, 1);
XFlush(manager.display);
XChangeProperty(Window.XDisplay, Result, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_100, 1);
XFlush(Window.XDisplay);
XSetErrorHandler(Old_handler);
end;
{$ELSE}
function TMWindowSelector.Drag: TNativeWindow;
function TMWindowSelector.Drag: Hwnd;
var
TargetRect: TRect;
DC: HDC;
@ -194,8 +192,6 @@ begin;
Sleep(64);
end;
Result := TempHandle;
LastPick:= TempHandle;
haspicked:= true;
Screen.Cursor:= cursor;
Invalidaterect(temphandle, nil, true);
UpdateWindow(temphandle);

48
branches/iomanager/Units/MMLCore/bitmaps.pas
View File

@ -110,48 +110,12 @@ type
destructor Destroy;override;
end;
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
implementation
uses
paszlib,DCPbase64,math,
colour_conv,IOManager,mufasatypesutil,tpa;
// Needs more fixing. We need to either copy the memory ourself, or somehow
// find a TRawImage feature to skip X bytes after X bytes read. (Most likely a
// feature)
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
Begin
RawImage.Init; { Calls raw.Description.Init as well }
RawImage.Description.PaletteColorCount:=0;
RawImage.Description.MaskBitsPerPixel:=0;
RawImage.Description.Width := Size.X;
RawImage.Description.Height:= Size.Y;
RawImage.Description.Format := ricfRGBA;
RawImage.Description.ByteOrder := riboLSBFirst;
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
RawImage.Description.Depth:=24;
RawImage.Description.BitsPerPixel:=32;
RawImage.Description.LineOrder:=riloTopToBottom;
RawImage.Description.LineEnd := rileDWordBoundary;
RawImage.Description.RedPrec := 8;
RawImage.Description.GreenPrec:= 8;
RawImage.Description.BluePrec:= 8;
RawImage.Description.AlphaPrec:=0;
RawImage.Description.RedShift:=16;
RawImage.Description.GreenShift:=8;
RawImage.Description.BlueShift:=0;
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
* (RawImage.Description.bitsperpixel shr 3);
RawImage.Data := PByte(Ptr);
End;
Windowutil,paszlib,DCPbase64,math,
colour_conv,window,mufasatypesutil,tpa;
function Min(a,b:integer) : integer;
begin
@ -710,11 +674,11 @@ begin
wi := Min(xe-xs + 1,Self.w);
hi := Min(ye-ys + 1,Self.h);
PtrRet := TIOManager_Abstract(MWindow).ReturnData(xs,ys,wi,hi);
PtrRet := TMWindow(MWindow).ReturnData(xs,ys,wi,hi);
for y := 0 to (hi-1) do
Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32));
TIOManager_Abstract(MWindow).FreeReturnData;
TMWindow(MWindow).FreeReturnData;
end;
procedure TMufasaBitmap.CopyClientToBitmap(MWindow: TObject; Resize: boolean;
@ -729,11 +693,11 @@ begin
wi := Min(xe-xs + 1 + x,Self.w);
hi := Min(ye-ys + 1 + y,Self.h);
PtrRet := TIOManager_Abstract(MWindow).ReturnData(xs,ys,wi - x,hi - y);
PtrRet := TMWindow(MWindow).ReturnData(xs,ys,wi - x,hi - y);
for yy := 0 to (hi-1 - y) do
Move(PtrRet.Ptr[yy * (wi - x + PtrRet.IncPtrWith)], FData[(yy + y) * self.w + x],wi * SizeOf(TRGB32));
TIOManager_Abstract(MWindow).FreeReturnData;
TMWindow(MWindow).FreeReturnData;
end;

17
branches/iomanager/Units/MMLCore/client.pas
View File

@ -30,9 +30,7 @@ interface
uses
Classes, SysUtils, MufasaTypes,
IOManager, Files, Finder, Bitmaps, dtm, ocr,
{$IFDEF MSWINDOWS} os_windows {$ENDIF}
{$IFDEF LINUX} os_linux {$ENDIF};
Window, Input, Files, Finder, Bitmaps, dtm, ocr;
{
TClient is a full-blown instance of the MML.
@ -41,11 +39,12 @@ It binds all the components together.
type
TClient = class(TObject)
constructor Create(plugin_dir: string);
constructor Create;
destructor Destroy; override;
public
IOManager: TIOManager;
MWindow: TMWindow;
MInput: TMInput;
MFiles: TMFiles;
MFinder: TMFinder;
MBitmaps : TMBitmaps;
@ -57,11 +56,12 @@ type
implementation
// Possibly pass arguments to a default window.
constructor TClient.Create(plugin_dir: string);
constructor TClient.Create;
begin
inherited Create;
IOManager:= TIOManager.Create(plugin_dir);
MWindow := TMWindow.Create;
MInput := TMInput.Create(MWindow);
MFiles := TMFiles.Create;
MFinder := TMFinder.Create(Self);
MBitmaps := TMBitmaps.Create(self);
@ -76,7 +76,8 @@ begin
MBitmaps.Free;
MFinder.Free;
MFiles.Free;
IOManager.Free;
MInput.Free;
MWindow.Free;
inherited;
end;

106
branches/iomanager/Units/MMLCore/finder.pas
View File

@ -351,7 +351,7 @@ begin
raise Exception.createFMT('Any Find Function, you did not pass a ' +
'correct ys: %d.', [ys]);
TClient(Self.Client).IOManager.GetDimensions(w,h);
TClient(Self.Client).MWindow.GetDimensions(w,h);
if (w <> CachedWidth) or (h <> CachedHeight) then
UpdateCachedValues(w,h);
if xe >= w then
@ -379,7 +379,7 @@ begin
dX := xe - xs;
dY := ye - ys;
ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith;
CCts := Self.CTS;
@ -400,7 +400,7 @@ begin
end;
Inc(Ptr, PtrInc)
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.CountColor(Color, xs, ys, xe, ye: Integer): Integer;
@ -422,7 +422,7 @@ begin
//next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
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.
@ -441,7 +441,7 @@ begin
Inc(Ptr, PtrInc)
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColor(out x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean;
@ -463,7 +463,7 @@ begin
//next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
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.
@ -481,7 +481,7 @@ begin
x := xx;
y := yy;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
Exit;
end;
Inc(Ptr);
@ -489,7 +489,7 @@ begin
Inc(Ptr, PtrInc)
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColorSpiral(var x, y: Integer; color, xs, ys, xe,
@ -511,7 +511,7 @@ begin
//next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Load rowdata
RowData:= CalculateRowPtrs(ptrdata,dy+1);
//Load the spiral path
@ -526,11 +526,11 @@ begin
Result := True;
x := ClientTPA[i].x + xs;
y := ClientTPA[i].y + ys;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
Exit;
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColoredArea(var x, y: Integer; Color, xs, ys, xe, ye, MinArea: Integer): Boolean;
@ -554,7 +554,7 @@ begin
//next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
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.
@ -586,7 +586,7 @@ begin
Result := True;
x := xx;
y := yy;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
Exit;
end;
end;
@ -604,7 +604,7 @@ begin
Inc(Ptr, PtrInc);
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
@ -634,7 +634,7 @@ begin
if Cts = 2 then
RGBToHSLNonFixed(clR,clG,clB,H1,S1,L1);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
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.
@ -730,14 +730,14 @@ begin
end;
end;
Result := False;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
Exit;
Hit:
Result := True;
x := xx;
y := yy;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColorTolerance(out x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean;
@ -766,7 +766,7 @@ begin
if Cts = 2 then
RGBToHSL(clR,clG,clB,H1,S1,L1);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
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.
@ -821,14 +821,14 @@ begin
end;
end;
Result := False;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
Exit;
Hit:
Result := True;
x := xx;
y := yy;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColoredAreaTolerance(var x, y: Integer; Color, xs, ys, xe, ye, MinArea, tol: Integer): Boolean;
@ -854,7 +854,7 @@ begin
ColorToRGB(Color, clR, clG, clB);
if Cts = 2 then
RGBToHSL(clR,clG,clB,H1,S1,L1);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
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.
@ -899,14 +899,14 @@ begin
end;
Result := False;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
Exit;
Hit:
Result := True;
x := xx;
y := yy;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColorsTolerance(out Points: TPointArray; Color, xs, ys,
@ -930,7 +930,7 @@ begin
if CTS = 2 then
ColorToHSL(color,H1,S1,L1);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
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.
@ -994,7 +994,7 @@ begin
SetLength(Points, C);
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
Result := C > 0;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColorsToleranceOptimised(out Points: TPointArray; Color, xs, ys,
xe, ye, Tol: Integer): Boolean;
@ -1017,7 +1017,7 @@ begin
if CTS = 2 then
RGBToHSLNonFixed(clR,clG,clB,H1,S1,L1);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
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.
@ -1122,7 +1122,7 @@ begin
SetLength(Points, C);
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
Result := C > 0;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColorsSpiralTolerance(x, y: Integer;
@ -1144,7 +1144,7 @@ begin
ColorToRGB(Color, clR, clG, clB);
ColorToHSL(Color, H1, S1, L1);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
c := 0;
@ -1199,7 +1199,7 @@ begin
SetLength(Points, C);
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
Result := C > 0;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColors(out TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean;
@ -1220,7 +1220,7 @@ begin
ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith;
@ -1246,7 +1246,7 @@ begin
Result := I > 0;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
{ Only works with CTS 1 for now.. Since Colorsame doesn't return a boolean :-( }
@ -1274,7 +1274,7 @@ begin
dX := xe - xs;
dY := ye - ys;
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
@ -1321,12 +1321,12 @@ begin
//We have found the mask appearntly, otherwise we would have jumped! Gna Gna.
x := xx + xs;
y := yy + ys;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
Exit(true);
//Bah not found the mask, lets do nothing and continue!
NotFoundMask:
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
procedure TMFinder.CheckMask(Mask: TMask);
@ -1339,7 +1339,7 @@ function TMFinder.FindBitmap(bitmap: TMufasaBitmap; out x, y: Integer): Boolean;
var
w,h : integer;
begin
TClient(Client).IOManager.GetDimensions(w,h);
TClient(Client).MWindow.GetDimensions(w,h);
result := Self.FindBitmapIn(bitmap,x,y,0,0,w-1,h-1);
end;
@ -1366,7 +1366,7 @@ begin
dX := xe - xs;
dY := ye - ys;
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap);
@ -1393,14 +1393,14 @@ begin
end;
//We did find the Bmp, otherwise we would be at the part below
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
x := xx + xs;
y := yy + ys;
result := true;
exit;
NotFoundBmp:
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs,
@ -1428,7 +1428,7 @@ begin
dX := xe - xs;
dY := ye - ys;
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap);
@ -1462,14 +1462,14 @@ begin
end;
//We did find the Bmp, otherwise we would be at the part below
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
x := xx + xs;
y := yy + ys;
result := true;
exit;
NotFoundBmp:
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer;
@ -1495,7 +1495,7 @@ begin
dX := xe - xs;
dY := ye - ys;
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap);
@ -1524,14 +1524,14 @@ begin
end;
//We did find the Bmp, otherwise we would be at the part below
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
x := ClientTPA[i].x + xs;
y := ClientTPA[i].y + ys;
result := true;
exit;
NotFoundBmp:
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x,
@ -1559,7 +1559,7 @@ begin
dX := xe - xs;
dY := ye - ys;
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap);
@ -1602,7 +1602,7 @@ begin
exit;
NotFoundBmp:
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x,
@ -1631,7 +1631,7 @@ begin
dX := xe - xs;
dY := ye - ys;
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap);
@ -1680,7 +1680,7 @@ begin
SetLength(Points,FoundC);
Move(ClientTPA[0], Points[0], FoundC * SizeOf(TPoint));
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x,
@ -1715,7 +1715,7 @@ begin
dY := ye - ys;
SearchDx := dX;
SearchDy := dY;
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
//Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap);
@ -1775,7 +1775,7 @@ begin
BestPT := Point(xx+xs,yy+ys);
if GoodCount = TotalC then
begin;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
x := BestPT.x;
y := BestPT.y;
accuracy:= 1;
@ -1783,7 +1783,7 @@ begin
end;
end;
end;
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
if BestCount = 0 then
Exit;
accuracy := BestCount / TotalC;
@ -1880,7 +1880,7 @@ begin
C := DTM.c;
// Retreive Client Data.
PtrData := TClient(Client).IOManager.ReturnData(x1, y1, W + 1, H + 1);
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, W + 1, H + 1);
cd := CalculateRowPtrs(PtrData, h + 1);
//writeln(format('w,h: %d, %d', [w,h]));
@ -1937,7 +1937,7 @@ begin
end;
TheEnd:
TClient(Client).IOManager.FreeReturnData;
TClient(Client).MWindow.FreeReturnData;
SetLength(Points, pc);
if pc > 0 then

610
branches/iomanager/Units/MMLCore/iomanager.pas
View File

@ -1,610 +0,0 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Input/Output manager for Mufasa Macro Library
}
unit IOManager;
interface
uses
Classes, SysUtils, mufasatypes, graphics, LCLType, bitmaps, LCLIntf, plugins, dynlibs;
type
{ This is the base class for the target functionality. If it provides a target, it extends this.
| Some methods in heregratuitous provide default functionality as a convinence. Only override as nessessary }
TTarget = class(TObject)
public
{ ONLY override some of the following methods if the target provides image functions, defaults
| to raise exceptions. GetColor provides default functionality using ReturData of width 1.
| FreeReturnData provides default of doing nothing. }
procedure GetTargetDimensions(var w, h: integer); virtual;
function GetColor(x,y : integer) : TColor; virtual;
function ReturnData(xs, ys, width, height: Integer): TRetData; virtual;
procedure FreeReturnData; virtual;
procedure ActivateClient; virtual;
{ ONLY override the following methods if the target provides mouse functions, defaults to
| raise exceptions }
procedure GetMousePosition(var x,y: integer); virtual;
procedure MoveMouse(x,y: integer); virtual;
procedure HoldMouse(x,y: integer; button: TClickType); virtual;
procedure ReleaseMouse(x,y: integer; button: TClickType); virtual;
{ ONLY override the following methods if the target provides key functions, defaults to
| raise exceptions }
procedure SendString(str: string); virtual;
procedure HoldKey(key: integer); virtual;
procedure ReleaseKey(key: integer); virtual;
function IsKeyHeld(key: integer): boolean; virtual;
end;
{ Implements a target that is a raw pixel array, e.g. stuff from a bitmap or a frozen state.
| Currently this uses the pointer as-is, but it might be needed to make a local copy... }
TRawTarget = class(TTarget)
public
constructor Create(rgb: prgb32; w,h: integer);
destructor Destroy; override;
procedure GetTargetDimensions(var w, h: integer); override;
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
private
rgb: prgb32;
w,h: integer;
end;
{ Implements a target that is a Window in the operating system. This class is abstract, i.e.,
| the actual os-specific Implementation of TWindow is in one of the os units. }
TWindow_Abstract = class(TTarget)
public
procedure GetTargetDimensions(var w, h: integer); override; abstract;
function ReturnData(xs, ys, width, height: Integer): TRetData; override; abstract;
procedure ActivateClient; override; abstract;
procedure GetMousePosition(var x,y: integer); override; abstract;
procedure MoveMouse(x,y: integer); override; abstract;
procedure HoldMouse(x,y: integer; button: TClickType); override; abstract;
procedure ReleaseMouse(x,y: integer; button: TClickType); override; abstract;
procedure SendString(str: string); override; abstract;
procedure HoldKey(key: integer); override; abstract;
procedure ReleaseKey(key: integer); override; abstract;
function IsKeyHeld(key: integer): boolean; override; abstract;
end;
{ Contains the pointers to a non-internal target implementation using the EIOS specification.
| N.B. this *is* the specification that I will finalize the speficication as... Once this is
| finalized that is. Trust me, its >9000 times easier to use a buffer across the language
| barrier. And the internal target implementation of EIOS will make that verry efficient. }
TEIOS_Client = record
RequestTarget: function(initdata: pointer): pointer; stdcall;
ReleaseTarget: procedure(target: pointer); stdcall;
GetTargetDimensions: procedure(target: pointer; var w, h: integer); stdcall;
GetImageBuffer: function(target: pointer): prgb32; stdcall;
UpdateImageBuffer: procedure(target: pointer); stdcall;
UpdateImageBufferBounds: procedure(target: pointer; sx,sy,ex,ey: integer); stdcall;
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
SendString: procedure(target: pointer; str: PChar); stdcall;
HoldKey: procedure(target: pointer; key: integer); stdcall;
ReleaseKey: procedure(target: pointer; key: integer); stdcall;
IsKeyHeld: function(target: pointer; key: integer): boolean; stdcall;
end;
{ Implements a EIOS target. This is, for all intensive purposes, a TRawTarget with added
| key and mouse methods, as well as the capability to request a buffer update. N.B. that
| some EIOS implementors can and will update the buffer on their own. In that case, the
| UpdateImageBuffer call is just a call to an empty method, OR does not exist. In the case
| of an EIOS client not needing a method defined, it will not be exported and will be set
| to NIL here. I think. Will get back to that. }
TEIOS_Target = class(TTarget)
public
constructor Create(client: TEIOS_Client; initval: pointer);
destructor Destroy; override;
procedure GetTargetDimensions(var w, h: integer); override;
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
procedure GetMousePosition(var x,y: integer); override;
procedure MoveMouse(x,y: integer); override;
procedure HoldMouse(x,y: integer; button: TClickType); override;
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
procedure SendString(str: string); override;
procedure HoldKey(key: integer); override;
procedure ReleaseKey(key: integer); override;
function IsKeyHeld(key: integer): boolean; override;
private
client: TEIOS_Client;
target: pointer;
buffer: prgb32;
width,height: integer;
end;
{ EIOS Clients will give an exported name, have a loaded library associated, and have
| a TEIOS_Client with the method pointers set. }
type TEIOS_LoadedPlugin = record
name: string;
client: TEIOS_Client;
end;
{ This is just a class that loads EIOS clients (like SMART) and sets them up to be used
| as targets. I hope to have a method like...
| function SetTarget(eios_name: pchar; init_args: variant): integer;
| where the init_args variant will be implied to be anything that can be cast to a pointer
| in the binary side after it gets out of PascalScript. So, the only thing to setup SMART
| would be the single call....
| SetTarget('SMART',SmartSetupRecord);
| Sexy, right? ;}
TEIOS_Controller = class(TGenericLoader)
public
constructor Create(plugin_dir: string);
destructor Destroy; override;
function ClientExists(name: string): boolean;
function GetClient(name: string): TEIOS_Client;
protected
function InitPlugin(plugin: TLibHandle): boolean; override;
private
plugs: array of TEIOS_LoadedPlugin;
function FindClient(name:string): integer;
end;
{ This class specifies the object that will go in the ThreadVar to give the script access
| to targets. This class is abstract, i.e., the actual os-specific Implementation of
| TIOManager is in one of the os units.
| I assume you Simba people know what the methods you made do, and I'm mantaining
| Name -> Function compatibility from the TWindow and TMInput classes (e.g. key, image,
| and window functions). I decided to split targeting into input/output == image/keymouse,
| since they sometimes are treated as seperate entities. }
TIOManager_Abstract = class(TObject)
public
constructor Create(plugin_dir: string);
destructor Destroy; override;
procedure SetDesktop; virtual; abstract;
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
function SetTarget(bmp : TMufasaBitmap) : integer; overload;
function SetTarget(name: string; initargs: pointer): integer; overload;
function TargetValid: Boolean;
function GetColor(x,y : integer) : TColor;
function ReturnData(xs, ys, width, height: Integer): TRetData;
procedure FreeReturnData;
procedure GetDimensions(var W, H: Integer);
procedure ActivateClient;
function IsFrozen: boolean;
procedure SetFrozen(makefrozen: boolean);
procedure GetMousePos(var X, Y: Integer);
procedure SetMousePos(X, Y: Integer);
procedure HoldMouse(x,y : integer; button: TClickType);
procedure ReleaseMouse(x,y : integer; button: TClickType);
procedure ClickMouse(X, Y: Integer; button: TClickType);
procedure KeyUp(key: Word);
procedure KeyDown(key: Word);
procedure PressKey(key: Word);
procedure SendText(text: string);
function isKeyDown(key: Word): Boolean;
protected
controller: TEIOS_Controller;
keymouse: TTarget;
image: TTarget;
frozen: TTarget;
freezebuffer: prgb32;
bothsame: boolean;
procedure SetImageTarget(target: TTarget);
procedure SetKeyMouseTarget(target: TTarget);
procedure SetBothTargets(target: TTarget);
procedure NativeInit; virtual; abstract;
procedure NativeFree; virtual; abstract;
end;
implementation
uses FileUtil,
{$IFDEF MSWINDOWS} os_windows {$ENDIF}
{$IFDEF LINUX} os_linux {$ENDIF};
//***implementation*** TIOManager
constructor TIOManager_Abstract.Create(plugin_dir: string);
begin
inherited Create;
controller:= TEIOS_Controller.Create(plugin_dir);
keymouse:= nil;
image:= nil;
frozen:= nil;
NativeInit;
SetDesktop;
end;
destructor TIOManager_Abstract.Destroy;
begin
if bothsame then keymouse.Destroy() else
begin
keymouse.Free();
image.Free();
end;
if frozen <> nil then frozen.Destroy();
if controller <> nil then controller.Destroy();
end;
procedure TIOManager_Abstract.SetImageTarget(target: TTarget);
begin
if frozen <> nil then
raise Exception.Create('You cannot set a target when Frozen');
if not(bothsame) then image.Free();
image:= target;
bothsame:= false;
end;
procedure TIOManager_Abstract.SetKeyMouseTarget(target: TTarget);
begin
if not(bothsame) then keymouse.Free();
keymouse:= target;
bothsame:= false;
end;
procedure TIOManager_Abstract.SetBothTargets(target: TTarget);
begin
if frozen <> nil then
raise Exception.Create('You cannot set a target when Frozen');
if bothsame then image.Destroy() else
begin
image.Free();
keymouse.Free();
end;
image:= target;
keymouse:= target;
bothsame:= true;
end;
procedure TIOManager_Abstract.SetFrozen(makefrozen: boolean);
var
w,h: integer;
buffer: TRetData;
begin
if (makefrozen) and (frozen <> nil) then
raise Exception.Create('The window is already frozen.');
//BenLand100 edit: I say we leave this exception out. POLS
//if not(isfrozen) and (frozen = nil) then
// raise Exception.Create('The window is not frozen.');
if makefrozen then
begin
image.Destroy();
image:= frozen;
end else if frozen = nil then
begin
frozen:= image;
frozen.GetTargetDimensions(w,h);
buffer:= frozen.ReturnData(0,0,w,h);
GetMem(freezebuffer, w * h * sizeof(TRGB32));
Move(buffer.Ptr[0], freezebuffer[0], w*h*sizeof(TRGB32));
frozen.FreeReturnData;
image:= TRawTarget.Create(freezebuffer,w,h);
end;
end;
function TIOManager_Abstract.IsFrozen: boolean;
begin
result:= frozen <> nil;
end;
function TIOManager_Abstract.GetColor(x,y : integer) : TColor; begin result:= image.GetColor(x,y); end;
function TIOManager_Abstract.ReturnData(xs,ys,width,height: integer): TRetData; begin result:= image.ReturnData(xs,ys,width,height); end;
procedure TIOManager_Abstract.FreeReturnData; begin image.freeReturnData(); end;
function TIOManager_Abstract.SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; begin SetImageTarget(TRawTarget.Create(ArrPtr,Size.X,Size.Y)); end;
function TIOManager_Abstract.SetTarget(bmp : TMufasaBitmap) : integer; begin SetImageTarget(TRawTarget.Create(bmp.FData,bmp.width,bmp.height)); end;
function TIOManager_Abstract.SetTarget(name: string; initargs: pointer): integer;
var
client: TEIOS_Client;
begin
if not controller.ClientExists(name) then raise Exception.Create('EIOS Client by specified name does not exist');
client:= controller.GetClient(name);
SetBothTargets(TEIOS_Target.Create(client, initargs));
end;
function TIOManager_Abstract.TargetValid: Boolean;
begin
result:= (keymouse <> nil) and (image <> nil);
end;
procedure TIOManager_Abstract.GetDimensions(var W, H: Integer); begin image.GetTargetDimensions(w,h) end;
procedure TIOManager_Abstract.ActivateClient; begin {lolwat} end;
procedure TIOManager_Abstract.GetMousePos(var X, Y: Integer); begin keymouse.GetMousePosition(x,y) end;
procedure TIOManager_Abstract.SetMousePos(X, Y: Integer); begin keymouse.MoveMouse(x,y); end;
procedure TIOManager_Abstract.HoldMouse(x,y : integer; button: TClickType); begin keymouse.ReleaseMouse(x,y,button); end;
procedure TIOManager_Abstract.ReleaseMouse(x,y : integer; button: TClickType); begin keymouse.ReleaseMouse(x,y,button); end;
procedure TIOManager_Abstract.ClickMouse(X, Y: Integer; button: TClickType);
begin
HoldMouse(x,y,button);
//BenLand100 note: probably should wait here
ReleaseMouse(x,y,button);
end;
procedure TIOManager_Abstract.KeyUp(key: Word); begin keymouse.ReleaseKey(key) end;
procedure TIOManager_Abstract.KeyDown(key: Word); begin keymouse.HoldKey(key) end;
procedure TIOManager_Abstract.PressKey(key: Word); begin keyup(key); keydown(key); end;
procedure TIOManager_Abstract.SendText(text: string); begin keymouse.SendString(PChar(@text[1])); end;
function TIOManager_Abstract.isKeyDown(key: Word): Boolean; begin result:= keymouse.IsKeyHeld(key); end;
//***implementation*** TTarget
procedure TTarget.GetTargetDimensions(var w, h: integer); begin raise Exception.Create('GetTargetDimensions not avaliable for this target'); end;
function TTarget.GetColor(x,y : integer) : TColor;
begin
with ReturnData(x,y,1,1) do
Result := RGBToColor(Ptr[0].r,Ptr[0].g,Ptr[0].b);
FreeReturnData;
end;
function TTarget.ReturnData(xs, ys, width, height: Integer): TRetData; begin raise Exception.Create('ReturnData not avaliable for this target'); end;
procedure TTarget.FreeReturnData; begin {do nothing by default} end;
procedure TTarget.ActivateClient; begin raise Exception.Create('ActivateClient not avaliable for this target'); end;
procedure TTarget.GetMousePosition(var x,y: integer); begin raise Exception.Create('GetMousePosition not avaliable for this target'); end;
procedure TTarget.MoveMouse(x,y: integer); begin raise Exception.Create('MoveMouse not avaliable for this target'); end;
procedure TTarget.HoldMouse(x,y: integer; button: TClickType); begin raise Exception.Create('HoldMouse not avaliable for this target'); end;
procedure TTarget.ReleaseMouse(x,y: integer; button: TClickType); begin raise Exception.Create('ReleaseMouse not avaliable for this target'); end;
procedure TTarget.SendString(str: string); begin raise Exception.Create('SendString not avaliable for this target'); end;
procedure TTarget.HoldKey(key: integer); begin raise Exception.Create('HoldKey not avaliable for this target'); end;
procedure TTarget.ReleaseKey(key: integer); begin raise Exception.Create('ReleaseKey not avaliable for this target'); end;
function TTarget.IsKeyHeld(key: integer): boolean; begin raise Exception.Create('IsKeyHeld not avaliable for this target'); end;
//***implementation*** TEIOS_Target
constructor TEIOS_Target.Create(client: TEIOS_Client; initval: pointer); begin
inherited Create;
self.client:= client;
if Pointer(client.RequestTarget) <> nil then
self.target:= client.RequestTarget(initval);
if Pointer(client.GetImageBuffer) <> nil then
self.buffer:= client.GetImageBuffer(target)
else
self.buffer:= nil;
GetTargetDimensions(self.width,self.height);
end;
destructor TEIOS_Target.Destroy; begin
client.ReleaseTarget(self.target);
inherited Destroy;
end;
procedure TEIOS_Target.GetTargetDimensions(var w, h: integer);
begin
if Pointer(client.GetTargetDimensions) <> nil then
client.GetTargetDimensions(target,w,h)
else
inherited GetTargetDimensions(w,h);
end;
function TEIOS_Target.ReturnData(xs, ys, width, height: Integer): TRetData;
begin
if Pointer(client.UpdateImageBufferBounds) <> nil then
client.UpdateImageBufferBounds(target,xs,ys,xs+width,ys+height)
else if Pointer(client.UpdateImageBuffer) <> nil then
client.UpdateImageBuffer(target)
else begin
{no update command exported}
end;
result.Ptr := buffer;
result.RowLen:= self.width;
result.IncPtrWith:= result.RowLen - width;
Inc(result.Ptr, ys * result.RowLen + xs);
end;
procedure TEIOS_Target.GetMousePosition(var x,y: integer);
begin
if Pointer(client.GetMousePosition) <> nil then
client.GetMousePosition(target,x,y)
else
inherited GetMousePosition(x,y);
end;
procedure TEIOS_Target.MoveMouse(x,y: integer);
begin
if Pointer(client.MoveMouse) <> nil then
client.MoveMouse(target,x,y)
else
inherited MoveMouse(x,y);
end;
procedure TEIOS_Target.HoldMouse(x,y: integer; button: TClickType);
begin
if Pointer(client.HoldMouse) <> nil then
begin
case button of
mouse_Left: client.HoldMouse(target,x,y,true);
mouse_Middle: raise Exception.Create('EIOS does not implement the middle mouse button.');
mouse_Right: client.HoldMouse(target,x,y,false);
end;
end else
inherited HoldMouse(x,y,button);
end;
procedure TEIOS_Target.ReleaseMouse(x,y: integer; button: TClickType);
begin
if Pointer(client.ReleaseMouse) <> nil then
begin
case button of
mouse_Left: client.ReleaseMouse(target,x,y,true);
mouse_Middle: raise Exception.Create('EIOS does not implement the middle mouse button.');
mouse_Right: client.ReleaseMouse(target,x,y,false);
end;
end else
inherited ReleaseMouse(x,y,button);
end;
procedure TEIOS_Target.SendString(str: string);
begin
if Pointer(client.SendString) <> nil then
client.SendString(target,PChar(@str[1]))
else
inherited SendString(str);
end;
procedure TEIOS_Target.HoldKey(key: integer);
begin
if Pointer(client.HoldKey) <> nil then
client.HoldKey(target,key)
else
inherited HoldKey(key);
end;
procedure TEIOS_Target.ReleaseKey(key: integer);
begin
if Pointer(client.ReleaseKey) <> nil then
client.ReleaseKey(target,key)
else
inherited ReleaseKey(key);
end;
function TEIOS_Target.IsKeyHeld(key: integer): boolean;
begin
if Pointer(client.IsKeyHeld) <> nil then
result:= client.IsKeyHeld(target,key)
else
result:= inherited IsKeyHeld(key);
end;
//***implementation*** TRawTarget
constructor TRawTarget.Create(rgb: prgb32; w,h: integer);
begin
inherited Create;
self.rgb:= rgb;
self.w:= w;
self.h:= h;
end;
destructor TRawTarget.Destroy;
begin
{do nothing}
inherited Destroy;
end;
procedure TRawTarget.GetTargetDimensions(var w, h: integer);
begin
w:= self.w;
h:= self.h;
end;
function TRawTarget.ReturnData(xs, ys, width, height: Integer): TRetData;
begin
result.Ptr := rgb;
result.RowLen:= self.w;
result.IncPtrWith:= result.RowLen - width;
Inc(result.Ptr, ys * result.RowLen + xs);
end;
//***implementation*** TEIOS_Controller
constructor TEIOS_Controller.Create(plugin_dir: string);
begin
inherited Create;
PluginDirs.Add(plugin_dir);
LoadPluginsDir(0);
end;
destructor TEIOS_Controller.Destroy;
var
i: integer;
begin
SetLength(plugs,0);
inherited Destroy;
end;
function TEIOS_Controller.InitPlugin(plugin: TLibHandle): boolean;
var
GetName: procedure(name: pchar); stdcall;
buffer: pchar;
idx: integer;
begin
Pointer(GetName) := GetProcAddress(plugin, PChar('EIOS_GetName'));
if Pointer(GetName) = nil then begin result:= false; exit; end;
idx:= Length(plugs);
SetLength(plugs,idx+1);
buffer:= stralloc(255);
GetName(buffer);
plugs[idx].name:= buffer;
strdispose(buffer);
{link in all eios methods that *might* exist}
with plugs[idx].client do
begin
Pointer(RequestTarget):= GetProcAddress(plugin, PChar('EIOS_RequestTarget'));
Pointer(ReleaseTarget):= GetProcAddress(plugin, PChar('EIOS_ReleaseTarget'));
Pointer(GetTargetDimensions):= GetProcAddress(plugin, PChar('EIOS_GetTargetDimensions'));
Pointer(GetImageBuffer):= GetProcAddress(plugin, PChar('EIOS_GetImageBuffer'));
Pointer(UpdateImageBuffer):= GetProcAddress(plugin, PChar('EIOS_UpdateImageBuffer'));
Pointer(UpdateImageBufferBounds):= GetProcAddress(plugin, PChar('EIOS_UpdateImageBufferBounds'));
Pointer(GetMousePosition):= GetProcAddress(plugin, PChar('EIOS_GetMousePosition'));
Pointer(MoveMouse):= GetProcAddress(plugin, PChar('EIOS_MoveMouse'));
Pointer(HoldMouse):= GetProcAddress(plugin, PChar('EIOS_HoldMouse'));
Pointer(ReleaseMouse):= GetProcAddress(plugin, PChar('EIOS_ReleaseMouse'));
Pointer(SendString):= GetProcAddress(plugin, PChar('EIOS_SendString'));
Pointer(HoldKey):= GetProcAddress(plugin, PChar('EIOS_HoldKey'));
Pointer(ReleaseKey):= GetProcAddress(plugin, PChar('EIOS_ReleaseKey'));
Pointer(IsKeyHeld):= GetProcAddress(plugin, PChar('EIOS_IsKeyHeld'));
end;
{done linking in methods}
result:= true;
end;
function TEIOS_Controller.FindClient(name: string): integer;
var
i: integer;
begin
for i:= 0 to length(plugs) - 1 do
if plugs[i].name = name then
begin
result:= i;
exit;
end;
result:= -1;
end;
function TEIOS_Controller.ClientExists(name: string): boolean;
begin
result:= FindClient(name) >= 0;
end;
function TEIOS_Controller.GetClient(name: string): TEIOS_Client;
var
i: integer;
begin
i:= FindClient(name);
if i >= 0 then
result:= plugs[i].client
end;
end.

4
branches/iomanager/Units/MMLCore/mufasatypes.pas
View File

@ -29,7 +29,7 @@ interface
uses
Classes, SysUtils,plugins;
Classes, SysUtils, LibLoader;
const
DS = DirectorySeparator;
MEOL = {$ifdef MSWINDOWS}#13+{$endif}#10;
@ -115,8 +115,6 @@ type
SubPoints: TDTMPointDefArray;
end;
var
PluginsGlob : TMPlugins;
type
VirtualKeyInfo = record
Str : string;

2
branches/iomanager/Units/MMLCore/ocr.pas
View File

@ -471,7 +471,7 @@ begin
bmp.SetSize(w + 2, h + 2);
// Copy the client to out working bitmap.
bmp.CopyClientToBitmap(TClient(Client).IOManager, False, 1{0},1, sx, sy, sx + w - 1, sy + h - 1);
bmp.CopyClientToBitmap(TClient(Client).MWindow, False, 1{0},1, sx, sy, sx + w - 1, sy + h - 1);
{$IFDEF OCRSAVEBITMAP}
bmp.SaveToFile(OCRDebugPath + 'ocrinit.bmp');

353
branches/iomanager/Units/MMLCore/os_linux.pas
View File

@ -1,353 +0,0 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Linux OS specific implemetation for Mufasa Macro Library
}
unit os_linux;
interface
uses
Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest, keysym;
type
TNativeWindow = x.TWindow;
TKeyInput = class(TXKeyInput)
public
procedure Down(Key: Word);
procedure Up(Key: Word);
end;
TWindow = class(TWindow_Abstract)
public
constructor Create(display: PDisplay; screennum: integer; window: x.TWindow);
destructor Destroy; override;
procedure GetTargetDimensions(var w, h: integer); override;
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
procedure FreeReturnData; override;
procedure ActivateClient; override;
procedure GetMousePosition(var x,y: integer); override;
procedure MoveMouse(x,y: integer); override;
procedure HoldMouse(x,y: integer; button: TClickType); override;
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
procedure SendString(str: string); override;
procedure HoldKey(key: integer); override;
procedure ReleaseKey(key: integer); override;
function IsKeyHeld(key: integer): boolean; override;
private
display: PDisplay;
screennum: integer;
window: x.TWindow;
buffer: PXImage;
dirty: Boolean; //true if image loaded
keyinput: TKeyInput;
end;
TIOManager = class(TIOManager_Abstract)
public
constructor Create(plugin_dir: string);
function SetTarget(target: TNativeWindow): integer; overload;
procedure SetDesktop; override;
private
procedure NativeInit; override;
procedure NativeFree; override;
public
display: PDisplay;
screennum: integer;
desktop: x.TWindow;
end;
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl;
implementation
uses GraphType, interfacebase, lcltype;
// Too global.
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
begin;
result := 0;
Writeln('X Error: ');
writeln('Error code: ' + inttostr(para2^.error_code));
writeln('Display: ' + inttostr(LongWord(para2^.display)));
writeln('Minor code: ' + inttostr(para2^.minor_code));
writeln('Request code: ' + inttostr(para2^.request_code));
writeln('Resource ID: ' + inttostr(para2^.resourceid));
writeln('Serial: ' + inttostr(para2^.serial));
writeln('Type: ' + inttostr(para2^._type));
end;
//***implementation*** TKeyInput
procedure TKeyInput.Down(Key: Word);
begin
DoDown(Key);
end;
procedure TKeyInput.Up(Key: Word);
begin
DoUp(Key);
end;
//***implementation*** TWindow
constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow);
begin
inherited Create;
self.display:= display;
self.screennum:= screennum;
self.window:= window;
self.dirty:= false;
self.keyinput:= TKeyInput.Create
end;
destructor TWindow.Destroy;
begin
FreeReturnData;
keyinput.Free;
inherited Destroy;
end;
procedure TWindow.GetTargetDimensions(var w, h: integer);
var
Old_Handler: TXErrorHandler;
Attrib: TXWindowAttributes;
newx, newy: integer;
childwindow: x.TWindow;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
if XGetWindowAttributes(display, window, @Attrib) <> 0 Then
begin
{ I don't think we need this XTranslateCoordinates... :D }
XTranslateCoordinates(display, window, RootWindow(display, screennum), 0,0, @newx, @newy, @childwindow);
W := Attrib.Width;
H := Attrib.Height;
end else
begin
{ TODO: Raise Exception because the Window does not exist? }
W := -1;
H := -1;
end;
XSetErrorHandler(Old_Handler);
end;
procedure TWindow.ActivateClient;
var
Old_Handler: TXErrorHandler;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
{ TODO: Check if Window is valid? }
XSetInputFocus(display,window,RevertToParent,CurrentTime);
XFlush(display);
XSetErrorHandler(Old_Handler);
end;
function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData;
var
Old_Handler: TXErrorHandler;
w,h: integer;
begin
GetTargetDimensions(w,h);
if (xs < 0) or (xs + width > w) or (ys < 0) or (ys + height > h) then
raise Exception.CreateFMT('TMWindow.ReturnData: The parameters passed are wrong; xs,ys %d,%d width,height %d,%d',[xs,ys,width,height]);
if dirty then
raise Exception.CreateFmt('ReturnData was called again without freeing'+
' the previously used data. Do not forget to'+
' call FreeReturnData', []);
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
buffer := XGetImage(display, window, xs, ys, width, height, AllPlanes, ZPixmap);
if buffer = nil then
begin
Writeln('ReturnData: XGetImage Error. Dumping data now:');
Writeln('xs, ys, width, height: ' + inttostr(xs) + ', ' + inttostr(ys) +
', ' + inttostr(width) + ', ' + inttostr(height));
Result.Ptr := nil;
Result.IncPtrWith := 0;
XSetErrorHandler(Old_Handler);
raise Exception.CreateFMT('TMWindow.ReturnData: ReturnData: XGetImage Error', []);
exit;
end;
Result.Ptr := PRGB32(buffer^.data);
Result.IncPtrWith := 0;
Result.RowLen := width;
dirty:= true;
XSetErrorHandler(Old_Handler);
end;
procedure TWindow.FreeReturnData;
begin
if dirty then
begin
if (buffer <> nil) then
XDestroyImage(buffer);
buffer:= nil;
dirty:= false;
end;
end;
procedure TWindow.GetMousePosition(var x,y: integer);
var
b:integer;
root, child: twindow;
xmask: Cardinal;
Old_Handler: TXErrorHandler;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XQueryPointer(display,window,@root,@child,@b,@b,@x,@y,@xmask);
XSetErrorHandler(Old_Handler);
end;
procedure TWindow.MoveMouse(x,y: integer);
var
Old_Handler: TXErrorHandler;
w,h: integer;
begin
GetTargetDimensions(w, h);
if (x < 0) or (y < 0) or (x > w) or (y > h) then
raise Exception.CreateFmt('SetMousePos: X, Y (%d, %d) is not valid (0,0,%d,%d)', [x, y, w, h]);
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XWarpPointer(display, 0, window, 0, 0, 0, 0, X, Y);
XFlush(display);
XSetErrorHandler(Old_Handler);
end;
procedure TWindow.HoldMouse(x,y: integer; button: TClickType);
var
ButtonP: cuint;
_isPress: cbool;
Old_Handler: TXErrorHandler;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
_isPress := cbool(1);
case button of
mouse_Left: ButtonP:= Button1;
mouse_Middle: ButtonP:= Button2;
mouse_Right: ButtonP:= Button3;
end;
XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime);
XSetErrorHandler(Old_Handler);
end;
procedure TWindow.ReleaseMouse(x,y: integer; button: TClickType);
var
ButtonP: cuint;
_isPress: cbool;
Old_Handler: TXErrorHandler;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
_isPress := cbool(0);
case button of
mouse_Left: ButtonP:= Button1;
mouse_Middle: ButtonP:= Button2;
mouse_Right: ButtonP:= Button3;
end;
XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime);
XSetErrorHandler(Old_Handler);
end;
function GetSimpleKeyCode(c: char): word;
begin
case C of
'0'..'9' :Result := VK_0 + Ord(C) - Ord('0');
'a'..'z' :Result := VK_A + Ord(C) - Ord('a');
'A'..'Z' :Result := VK_A + Ord(C) - Ord('A');
' ' : result := VK_SPACE;
else
Raise Exception.CreateFMT('GetSimpleKeyCode - char (%s) is not in A..z',[c]);
end
end;
procedure TWindow.SendString(str: string);
var
i: integer;
key: byte;
HoldShift : boolean;
begin
HoldShift := false;
for i := 1 to length(str) do
begin
if((str[i] >= 'A') and (str[i] <= 'Z')) then
begin
HoldKey(VK_SHIFT);
HoldShift:= True;
str[i] := lowerCase(str[i]);
end else
if HoldShift then
begin
HoldShift:= false;
ReleaseKey(VK_SHIFT);
end;
key:= GetSimpleKeyCode(str[i]);
HoldKey(key);
//BenLand100: You should probably wait here...
ReleaseKey(key);
end;
if HoldShift then
ReleaseKey(VK_SHIFT);
end;
procedure TWindow.HoldKey(key: integer);
begin
keyinput.Down(key);
end;
procedure TWindow.ReleaseKey(key: integer);
begin
keyinput.Up(key);
end;
function TWindow.IsKeyHeld(key: integer): boolean;
begin
raise Exception.CreateFmt('IsKeyDown isn''t implemented yet on Linux', []);
end;
//***implementation*** IOManager
constructor TIOManager.Create(plugin_dir: string);
begin
inherited Create(plugin_dir);
end;
procedure TIOManager.NativeInit;
begin
display := XOpenDisplay(nil);
if display = nil then
begin
// throw Exception
end;
screennum:= DefaultScreen(display);
desktop:= RootWindow(display,screennum)
end;
procedure TIOManager.NativeFree;
begin
XCloseDisplay(display);
end;
procedure TIOManager.SetDesktop;
begin
SetBothTargets(TWindow.Create(display, screennum, desktop));
end;
function TIOManager.SetTarget(target: x.TWindow): integer;
begin
SetBothTargets(TWindow.Create(display, screennum, target))
end;
end.

333
branches/iomanager/Units/MMLCore/os_windows.pas
View File

@ -1,333 +0,0 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Windows OS specific implementation for Mufasa Macro Library
}
unit os_windows;
interface
uses
Classes, SysUtils, mufasatypes, windows, graphics, LCLType, bitmaps, LCLIntf, IOManager, WinKeyInput;
type
TNativeWindow = Hwnd;
TKeyInput = class(TWinKeyInput)
public
procedure Down(Key: Word);
procedure Up(Key: Word);
end;
TWindow = class(TWindow_Abstract)
public
constructor Create(target: Hwnd);
destructor Destroy; override;
procedure GetTargetDimensions(var w, h: integer); override;
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
function GetColor(x,y : integer) : TColor; override;
procedure ActivateClient; override;
procedure GetMousePosition(var x,y: integer); override;
procedure MoveMouse(x,y: integer); override;
procedure HoldMouse(x,y: integer; button: TClickType); override;
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
procedure SendString(str: string); override;
procedure HoldKey(key: integer); override;
procedure ReleaseKey(key: integer); override;
function IsKeyHeld(key: integer): boolean; override;
private
handle: Hwnd;
dc: HDC;
buffer: TBitmap;
buffer_raw: prgb32;
width,height: integer;
keyinput: TKeyInput;
procedure ValidateBuffer(w,h:integer);
end;
TIOManager = class(TIOManager_Abstract)
public
constructor Create(plugin_dir: string);
function SetTarget(target: Hwnd): integer; overload;
procedure SetDesktop; override;
protected
DesktopHWND : Hwnd;
procedure NativeInit; override;
procedure NativeFree; override;
end;
implementation
uses GraphType, interfacebase;
type
PMouseInput = ^TMouseInput;
tagMOUSEINPUT = packed record
dx: Longint;
dy: Longint;
mouseData: DWORD;
dwFlags: DWORD;
time: DWORD;
dwExtraInfo: DWORD;
end;
TMouseInput = tagMOUSEINPUT;
PKeybdInput = ^TKeybdInput;
tagKEYBDINPUT = packed record
wVk: WORD;
wScan: WORD;
dwFlags: DWORD;
time: DWORD;
dwExtraInfo: DWORD;
end;
TKeybdInput = tagKEYBDINPUT;
PHardwareInput = ^THardwareInput;
tagHARDWAREINPUT = packed record
uMsg: DWORD;
wParamL: WORD;
wParamH: WORD;
end;
THardwareInput = tagHARDWAREINPUT;
PInput = ^TInput;
tagINPUT = packed record
Itype: DWORD;
case Integer of
0: (mi: TMouseInput);
1: (ki: TKeybdInput);
2: (hi: THardwareInput);
end;
TInput = tagINPUT;
const
INPUT_MOUSE = 0;
INPUT_KEYBOARD = 1;
INPUT_HARDWARE = 2;
function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT; stdcall; external user32 name 'SendInput';
//***implementation*** TKeyInput
procedure TKeyInput.Down(Key: Word);
begin
DoDown(Key);
end;
procedure TKeyInput.Up(Key: Word);
begin
DoUp(Key);
end;
//***implementation*** TWindow
constructor TWindow.Create(target: Hwnd); begin
inherited Create;
self.handle:= target;
self.dc:= GetWindowDC(target);
self.buffer:= TBitmap.Create;
self.buffer.PixelFormat:= pf32bit;
keyinput:= TKeyInput.Create;
end;
destructor TWindow.Destroy; begin
ReleaseDC(handle,dc);
buffer.Free;
keyinput.Free;
inherited Destroy;
end;
procedure TWindow.ActivateClient;
begin
SetForegroundWindow(handle);
end;
procedure TWindow.GetTargetDimensions(var w, h: integer);
var
Rect : TRect;
begin
GetWindowRect(handle, Rect);
w:= Rect.Right - Rect.Left;
h:= Rect.Bottom - Rect.Top;
end;
function TWindow.GetColor(x,y : integer) : TColor;
begin
result:= GetPixel(self.dc,x,y)
end;
procedure TWindow.ValidateBuffer(w,h:integer);
var
BmpInfo : Windows.TBitmap;
begin
if (w <> self.width) or (height <> self.height) then
begin
buffer.SetSize(w,h);
self.width:= w;
self.height:= h;
GetObject(buffer.Handle, SizeOf(BmpInfo), @BmpInfo);
self.buffer_raw := BmpInfo.bmBits;
end;
end;
function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData;
var
temp: PRGB32;
w,h : integer;
begin
GetTargetDimensions(w,h);
ValidateBuffer(w,h);
if (xs < 0) or (xs + width > w) or (ys < 0) or (ys + height > h) then
raise Exception.CreateFMT('TMWindow.ReturnData: The parameters passed are wrong; xs,ys %d,%d width,height %d,%d',[xs,ys,width,height]);
BitBlt(self.buffer.Canvas.Handle,0,0, width, height, self.dc, xs,ys, SRCCOPY);
Result.Ptr:= self.buffer_raw;
Result.IncPtrWith:= w - width;
Result.RowLen:= w;
end;
procedure TWindow.GetMousePosition(var x,y: integer);
var
MousePoint : TPoint;
Rect : TRect;
begin
Windows.GetCursorPos(MousePoint);
GetWindowRect(handle,Rect);
x := MousePoint.x - Rect.Left;
y := MousePoint.y - Rect.Top;
end;
procedure TWindow.MoveMouse(x,y: integer);
var
rect : TRect;
w,h: integer;
begin
GetWindowRect(handle, Rect);
x := x + rect.left;
y := y + rect.top;
if (x<0) or (y<0) then
writeln('Negative coords, what now?');
Windows.SetCursorPos(x, y);
end;
procedure TWindow.HoldMouse(x,y: integer; button: TClickType);
var
Input : TInput;
Rect : TRect;
begin
GetWindowRect(handle, Rect);
Input.Itype:= INPUT_MOUSE;
FillChar(Input,Sizeof(Input),0);
Input.mi.dx:= x + Rect.left;
Input.mi.dy:= y + Rect.Top;
case button of
Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN;
Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEDOWN;
Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN;
end;
SendInput(1,Input, sizeof(Input));
end;
procedure TWindow.ReleaseMouse(x,y: integer; button: TClickType);
var
Input : TInput;
Rect : TRect;
begin
GetWindowRect(handle, Rect);
Input.Itype:= INPUT_MOUSE;
FillChar(Input,Sizeof(Input),0);
Input.mi.dx:= x + Rect.left;
Input.mi.dy:= y + Rect.Top;
case button of
Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP;
Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEUP;
Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP;
end;
SendInput(1,Input, sizeof(Input));
end;
procedure TWindow.SendString(str: string);
var
i: integer;
key: byte;
HoldShift : boolean;
begin
HoldShift := false;
for i := 1 to length(str) do
begin
if((str[i] >= 'A') and (str[i] <= 'Z')) then
begin
HoldKey(VK_SHIFT);
HoldShift:= True;
str[i] := lowerCase(str[i]);
end else
if HoldShift then
begin
HoldShift:= false;
ReleaseKey(VK_SHIFT);
end;
key:= VkKeyScan(str[i]) and $FF;
HoldKey(key);
//BenLand100 note: probably should wait here
ReleaseKey(key);
end;
if HoldShift then
ReleaseKey(VK_SHIFT);
end;
procedure TWindow.HoldKey(key: integer);
begin
keyinput.Down(key);
end;
procedure TWindow.ReleaseKey(key: integer);
begin
keyinput.Up(key);
end;
function TWindow.IsKeyHeld(key: integer): boolean;
begin
raise Exception.CreateFmt('IsKeyHeld isn''t implemented yet on Windows', []);
end;
//***implementation*** IOManager
constructor TIOManager.Create(plugin_dir: string);
begin
inherited Create(plugin_dir);
end;
procedure TIOManager.NativeInit;
begin
self.DesktopHWND:= GetDesktopWindow;
end;
procedure TIOManager.NativeFree;
begin
end;
procedure TIOManager.SetDesktop;
begin
SetBothTargets(TWindow.Create(DesktopHWND));
end;
function TIOManager.SetTarget(target: Hwnd): integer;
begin
SetBothTargets(TWindow.Create(target));
end;
end.

30
trunk/Projects/SAMufasaGUI/project1.lpi
View File

@ -10,7 +10,7 @@
<TargetFileExt Value=""/>
<Title Value="Simba"/>
<UseXPManifest Value="True"/>
<ActiveEditorIndexAtStart Value="0"/>
<ActiveEditorIndexAtStart Value="1"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
@ -139,7 +139,7 @@
<UnitName Value="TestUnit"/>
<ComponentState Value="1"/>
<CursorPos X="12" Y="312"/>
<TopLine Value="290"/>
<TopLine Value="235"/>
<EditorIndex Value="0"/>
<UsageCount Value="202"/>
<Loaded Value="True"/>
@ -267,7 +267,7 @@
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mmlpsthread"/>
<CursorPos X="25" Y="34"/>
<CursorPos X="57" Y="40"/>
<TopLine Value="23"/>
<EditorIndex Value="4"/>
<UsageCount Value="202"/>
@ -367,7 +367,7 @@
<CursorPos X="47" Y="47"/>
<TopLine Value="47"/>
<EditorIndex Value="8"/>
<UsageCount Value="30"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
</Unit44>
<Unit45>
@ -503,7 +503,7 @@
<CursorPos X="53" Y="13"/>
<TopLine Value="75"/>
<EditorIndex Value="6"/>
<UsageCount Value="41"/>
<UsageCount Value="42"/>
<Loaded Value="True"/>
</Unit64>
<Unit65>
@ -542,7 +542,7 @@
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="plugins"/>
<CursorPos X="12" Y="54"/>
<CursorPos X="15" Y="60"/>
<TopLine Value="34"/>
<EditorIndex Value="1"/>
<UsageCount Value="200"/>
@ -1596,7 +1596,7 @@
<ComponentState Value="1"/>
<CursorPos X="26" Y="295"/>
<TopLine Value="7"/>
<UsageCount Value="141"/>
<UsageCount Value="142"/>
</Unit223>
<Unit224>
<Filename Value="../../../usr/local/share/lazarus/lcl/comctrls.pp"/>
@ -1651,7 +1651,7 @@
<UnitName Value="simpleanalyzer"/>
<CursorPos X="52" Y="104"/>
<TopLine Value="193"/>
<UsageCount Value="128"/>
<UsageCount Value="129"/>
</Unit231>
<Unit232>
<Filename Value="../../Units/Misc/mPasLex.pas"/>
@ -1712,7 +1712,7 @@
<CursorPos X="30" Y="109"/>
<TopLine Value="98"/>
<EditorIndex Value="7"/>
<UsageCount Value="19"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit240>
<Unit241>
@ -1728,7 +1728,7 @@
<UnitName Value="updater"/>
<CursorPos X="38" Y="211"/>
<TopLine Value="65"/>
<UsageCount Value="101"/>
<UsageCount Value="102"/>
</Unit242>
<Unit243>
<Filename Value="updateform.pas"/>
@ -1739,7 +1739,7 @@
<CursorPos X="111" Y="102"/>
<TopLine Value="81"/>
<EditorIndex Value="5"/>
<UsageCount Value="96"/>
<UsageCount Value="97"/>
<Loaded Value="True"/>
</Unit243>
<Unit244>
@ -1861,7 +1861,7 @@
<UnitName Value="simbasettings"/>
<CursorPos X="26" Y="9"/>
<TopLine Value="11"/>
<UsageCount Value="59"/>
<UsageCount Value="60"/>
</Unit261>
<Unit262>
<Filename Value="../../Units/MMLAddon/settings.pas"/>
@ -1907,7 +1907,7 @@
<ComponentState Value="1"/>
<CursorPos X="53" Y="23"/>
<TopLine Value="21"/>
<UsageCount Value="42"/>
<UsageCount Value="43"/>
</Unit267>
<Unit268>
<Filename Value="../../Units/Synapse/synsock.pas"/>
@ -1964,7 +1964,7 @@
<UnitName Value="newinternets"/>
<CursorPos X="80" Y="2"/>
<TopLine Value="1"/>
<UsageCount Value="38"/>
<UsageCount Value="39"/>
</Unit275>
<Unit276>
<Filename Value="reportbug.lrs"/>
@ -2014,7 +2014,7 @@
<CursorPos X="20" Y="3"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="20"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit282>
<Unit283>