moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-25 18:52:15 -05: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): $(binary):
$(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) project1.lpr $(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',[ LazarusResources.Add('TDebugImgForm','FORMDATA',[
'TPF0'#13'TDebugImgForm'#12'DebugImgForm'#4'Left'#3#235#1#6'Height'#3','#1#3 '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' +'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' +'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' +'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 +#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 implementation
uses uses
MufasaTypes, math, graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase; MufasaTypes, math,windowutil,graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
{ TDebugImgForm } { TDebugImgForm }
procedure TDebugImgForm.FormCreate(Sender: TObject); procedure TDebugImgForm.FormCreate(Sender: TObject);

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

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

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

@ -29,12 +29,14 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads} {$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cmem, cthreads, cmem,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, Forms, testunit, colourhistory, About, internets, debugimage, Interfaces, // this includes the LCL widgetset
framefunctionlist, simpleanalyzer, updater, updateform, simbasettings; LResources, Forms, testunit, colourhistory, About, internets, debugimage,
framefunctionlist, simpleanalyzer, updater, updateform, simbasettings,
{$R project1.res} libloader;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
begin begin
{$I project1.lrs}
Application.Title:='Simba'; Application.Title:='Simba';
Application.Initialize; 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, {$ifdef linux}cthreads,{$endif}Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Menus, ComCtrls, ExtCtrls, SynEdit, SynHighlighterPas, SynMemo, StdCtrls, Menus, ComCtrls, ExtCtrls, SynEdit, SynHighlighterPas, SynMemo,
//Client, //Client,
MufasaTypes, MufasaTypes, plugins,
mmlpsthread,synedittypes, mmlpsthread,synedittypes,
{$IFDEF MSWINDOWS} os_windows, {$ENDIF} //For ColorPicker etc. window, // for the comp picker and selector
{$IFDEF LINUX} os_linux, {$ENDIF} //For ColorPicker etc.
colourpicker, framescript, windowselector, lcltype, ActnList, StdActns, colourpicker, framescript, windowselector, lcltype, ActnList, StdActns,
SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynEditMarkupSpecialLine, SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynEditMarkupSpecialLine,
SynEditMarkupHighAll, SynEditMiscClasses, LMessages, Buttons, PairSplitter, SynEditMarkupHighAll, SynEditMiscClasses, LMessages, Buttons, PairSplitter,
ColorBox , about, framefunctionlist, ocr, updateform, simbasettings; ColorBox, about, framefunctionlist, ocr, updateform, simbasettings;
const const
SimbaVersion = 429; SimbaVersion = 429;
@ -306,10 +305,11 @@ type
CurrScript : TScriptFrame; //The current scriptframe CurrScript : TScriptFrame; //The current scriptframe
CurrTab : TMufasaTab; //The current TMufasaTab CurrTab : TMufasaTab; //The current TMufasaTab
Tabs : TList; Tabs : TList;
Manager: TIOManager; Window: TMWindow;
OCR_Fonts: TMOCR; OCR_Fonts: TMOCR;
Picker: TMColorPicker; Picker: TMColorPicker;
Selector: TMWindowSelector; Selector: TMWindowSelector;
PluginsGlob: TMPlugins;
procedure FunctionListShown( ShowIt : boolean); procedure FunctionListShown( ShowIt : boolean);
property ScriptState : TScriptState read GetScriptState write SetScriptState; property ScriptState : TScriptState read GetScriptState write SetScriptState;
procedure SafeCallThread; procedure SafeCallThread;
@ -352,7 +352,7 @@ var
implementation implementation
uses uses
lclintf,plugins, lclintf,
syncobjs, // for the critical sections syncobjs, // for the critical sections
debugimage, debugimage,
bitmaps, bitmaps,
@ -527,13 +527,9 @@ begin
Writeln('The script hasn''t stopped yet, so we cannot start a new one.'); Writeln('The script hasn''t stopped yet, so we cannot start a new one.');
exit; exit;
end; 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; ScriptErrorLine:= -1;
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
ScriptThread := TMMLPSThread.Create(True,@CurrentSyncInfo,PluginsPath); ScriptThread := TMMLPSThread.Create(True,@CurrentSyncInfo);
{$IFNDEF TERMINALWRITELN} {$IFNDEF TERMINALWRITELN}
ScriptThread.SetDebug(@formWriteln); ScriptThread.SetDebug(@formWriteln);
ScriptThread.DebugMemo := Self.Memo1; ScriptThread.DebugMemo := Self.Memo1;
@ -551,6 +547,16 @@ begin
if ScriptFile <> '' then if ScriptFile <> '' then
ScriptPath := ExtractFileDir(ScriptFile); 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 if not DirectoryExists(PluginsPath) and not assigned(PluginsGlob) then
begin begin
if FirstRun then 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'); Writeln('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now');
ScriptThread.SetPaths(ScriptPath,AppPath,Includepath,PluginsPath,fontPath); 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'); loadFontsOnScriptStart := LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True');
@ -1264,9 +1272,9 @@ begin
Tabs := TList.Create; Tabs := TList.Create;
AddTab;//Give it alteast 1 tab ;-). AddTab;//Give it alteast 1 tab ;-).
FunctionListShown(True); //Show this function list bitch! FunctionListShown(True); //Show this function list bitch!
Manager := TIOManager.Create(''); //No need to load plugins for the Global manager Window := TMWindow.Create;
Picker := TMColorPicker.Create(Manager); Picker := TMColorPicker.Create(Window);
Selector := TMWindowSelector.Create(Manager); Selector := TMWindowSelector.Create(Window);
MainDir:= ExtractFileDir(Application.ExeName); MainDir:= ExtractFileDir(Application.ExeName);
{ For writeln } { For writeln }
SetLength(DebugStream, 0); SetLength(DebugStream, 0);
@ -1295,7 +1303,7 @@ begin
Tabs.free; Tabs.free;
Selector.Free; Selector.Free;
Picker.Free; Picker.Free;
Manager.Free; Window.Free;
PluginsGlob.Free; PluginsGlob.Free;
SetLength(DebugStream, 0); SetLength(DebugStream, 0);
@ -1480,7 +1488,7 @@ end;
procedure TForm1.MenuItemReportBugClick(Sender: TObject); procedure TForm1.MenuItemReportBugClick(Sender: TObject);
begin begin
//OpenURL('http://old.villavu.com/mantis/bug_report_page.php'); OpenURL('http://old.villavu.com/mantis/bug_report_page.php');
end; end;
procedure TForm1.MenuItemShowClick(Sender: TObject); procedure TForm1.MenuItemShowClick(Sender: TObject);
@ -1539,8 +1547,8 @@ end;
procedure TForm1.ButtonSelectorDown(Sender: TObject; Button: TMouseButton; procedure TForm1.ButtonSelectorDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
begin begin
Manager.SetTarget(Selector.Drag); Window.SetTarget(Selector.Drag {$ifdef MSWINDOWS},w_window{$endif});
writeln('New window: ' + IntToStr(Selector.LastPick)); writeln('New window: ' + IntToStr(Window.{$ifdef MSWindows}TargetHandle{$else}CurWindow{$ENDIF}));
end; end;
procedure TForm1.NoTray(Sender: TObject); 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); procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
begin 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; end;
function BitmapFromClient(const xs, ys, xe, ye: Integer): Integer; function BitmapFromClient(const xs, ys, xe, ye: Integer): Integer;
begin; begin;
result := CurrThread.Client.MBitmaps.CreateBMP(0,0); 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; end;
function FindBitmap(Bitmap: integer; out x, y: Integer): Boolean; 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; function GetColor(x,y : integer) : TColor;
begin; begin;
Result := CurrThread.Client.IOManager.GetColor(x,y); Result := CurrThread.Client.MWindow.GetColor(x,y);
end; end;
function findcolor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean; 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); procedure KeyDown(key: Word);
begin begin
CurrThread.Client.IOManager.KeyDown(key); CurrThread.Client.MInput.KeyDown(key);
end; end;
procedure KeyUp(key: Word); procedure KeyUp(key: Word);
begin begin
CurrThread.Client.IOManager.KeyUp(key); CurrThread.Client.MInput.KeyUp(key);
end; end;
procedure SendKeys(s: string); procedure SendKeys(s: string);
begin begin
CurrThread.Client.IOManager.SendText(s); CurrThread.Client.MInput.SendText(s);
end; end;
procedure PressKey(key: Word); procedure PressKey(key: Word);
begin begin
CurrThread.Client.IOManager.PressKey(key); CurrThread.Client.MInput.PressKey(key);
end; end;
function isKeyDown(key: Word): boolean; function isKeyDown(key: Word): boolean;
begin begin
Result := CurrThread.Client.IOManager.isKeyDown(key); Result := CurrThread.Client.MInput.isKeyDown(key);
end; end;

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

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

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

@ -53,9 +53,9 @@ var
w,h : integer; w,h : integer;
bmp: TMufasaBitmap; bmp: TMufasaBitmap;
begin; begin;
CurrThread.Client.IOManager.GetDimensions(w,h); CurrThread.Client.MWindow.GetDimensions(w,h);
bmp := TMufasaBitmap.Create; 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.SaveToFile(FileName);
bmp.Free; bmp.Free;
end; end;

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

@ -23,38 +23,36 @@
procedure SetDesktopAsClient; procedure SetDesktopAsClient;
begin; begin;
CurrThread.Client.IOManager.SetDesktop; CurrThread.Client.MWindow.SetDesktop;
end; end;
procedure SetTargetBitmap(bitmap: Integer); procedure SetTargetBitmap(bitmap: Integer);
begin; begin;
With CurrThread.Client do With CurrThread.Client do
IOManager.SetTarget(MBitmaps.Bmp[Bitmap]); MWindow.SetTarget(MBitmaps.Bmp[Bitmap]);
end; end;
procedure GetClientDimensions(out w, h: integer); procedure GetClientDimensions(out w, h: integer);
begin begin
CurrThread.Client.IOManager.GetDimensions(w, h); CurrThread.Client.MWindow.GetDimensions(w, h);
end; end;
function Freeze: boolean; function Freeze: boolean;
begin begin
CurrThread.Client.IOManager.SetFrozen(true); result := CurrThread.Client.MWindow.Freeze();
result := true;
end; end;
function Unfreeze: boolean; function Unfreeze: boolean;
begin begin
CurrThread.Client.IOManager.SetFrozen(false); result := CurrThread.Client.MWindow.Unfreeze;
result := true;
end; end;
procedure SetTargetArray(P: Integer; w, h: integer); procedure SetTargetArray(P: Integer; w, h: integer);
begin begin
CurrThread.Client.IOManager.SetTarget(PRGB32(P), classes.point(w,h)); CurrThread.Client.MWindow.SetTarget(PRGB32(P), classes.point(w,h));
end; end;
procedure activateclient; procedure activateclient;
begin begin
CurrThread.Client.IOManager.ActivateClient; CurrThread.Client.MWindow.ActivateClient;
end; 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(@PressKey, 'procedure PressKey(key: Word);');
AddFunction(@SendKeys, 'procedure SendKeys(s: string);'); AddFunction(@SendKeys, 'procedure SendKeys(s: string);');
AddFunction(@isKeyDown, 'function IsKeyDown(key: Word): Boolean;'); AddFunction(@isKeyDown, 'function IsKeyDown(key: Word): Boolean;');
AddFunction(@GetKeyCode, 'function GetKeyCode(Key : char) : byte');
{ OCR} { OCR}
SetCurrSection('OCR'); SetCurrSection('OCR');

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

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

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

@ -29,7 +29,9 @@ unit mmlpsthread;
interface interface
uses 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 type
{ TMMLPSThread } { TMMLPSThread }
@ -86,6 +88,7 @@ type
//DebugTo : TMemo; //DebugTo : TMemo;
DebugTo: TWritelnProc; DebugTo: TWritelnProc;
DebugImg : TDbgImgInfo; DebugImg : TDbgImgInfo;
PluginsGlob: TMPlugins;
PluginsToload : Array of integer; PluginsToload : Array of integer;
FOnError : TOnError; FOnError : TOnError;
procedure OnCompile(Sender: TPSScript); procedure OnCompile(Sender: TPSScript);
@ -111,7 +114,7 @@ type
procedure SetDebug( writelnProc : TWritelnProc ); procedure SetDebug( writelnProc : TWritelnProc );
procedure SetDbgImg( DebugImageInfo : TDbgImgInfo); procedure SetDbgImg( DebugImageInfo : TDbgImgInfo);
procedure SetPaths(ScriptP,AppP,IncludeP,PluginP,FontP : string); 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; destructor Destroy; override;
end; end;
threadvar threadvar
@ -129,6 +132,7 @@ uses
math, //Maths! math, //Maths!
internets, // internets internets, // internets
strutils, strutils,
input,
tpa, //Tpa stuff tpa, //Tpa stuff
forms,//Forms forms,//Forms
lclintf; // for GetTickCount and others. 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 begin
SyncInfo:= TheSyncInfo; SyncInfo:= TheSyncInfo;
SetLength(PluginsToLoad,0); SetLength(PluginsToLoad,0);
Client := TClient.Create(plugin_dir); Client := TClient.Create;
PSScript := TPSScript.Create(nil); PSScript := TPSScript.Create(nil);
PSScript.UsePreProcessor:= True; PSScript.UsePreProcessor:= True;
PSScript.OnNeedFile := @RequireFile; PSScript.OnNeedFile := @RequireFile;

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

@ -34,7 +34,7 @@ unit plugins;
interface interface
uses uses
Classes, SysUtils, dynlibs; Classes, SysUtils, dynlibs, LibLoader;
type type
TMPluginMethod = record TMPluginMethod = record
@ -48,28 +48,6 @@ type
end; end;
TMPluginArray = array of TMPlugin; 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 } { TMPlugins }
@ -91,115 +69,6 @@ uses
{ TMPlugins } { 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; function TMPlugins.InitPlugin(plugin: TLibHandle): boolean;
var var
pntrArrc : function : integer; stdcall; pntrArrc : function : integer; stdcall;

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

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

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

@ -110,48 +110,12 @@ type
destructor Destroy;override; destructor Destroy;override;
end; end;
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
implementation implementation
uses uses
paszlib,DCPbase64,math, Windowutil,paszlib,DCPbase64,math,
colour_conv,IOManager,mufasatypesutil,tpa; colour_conv,window,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;
function Min(a,b:integer) : integer; function Min(a,b:integer) : integer;
begin begin
@ -710,11 +674,11 @@ begin
wi := Min(xe-xs + 1,Self.w); wi := Min(xe-xs + 1,Self.w);
hi := Min(ye-ys + 1,Self.h); 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 for y := 0 to (hi-1) do
Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32)); Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32));
TIOManager_Abstract(MWindow).FreeReturnData; TMWindow(MWindow).FreeReturnData;
end; end;
procedure TMufasaBitmap.CopyClientToBitmap(MWindow: TObject; Resize: boolean; procedure TMufasaBitmap.CopyClientToBitmap(MWindow: TObject; Resize: boolean;
@ -729,11 +693,11 @@ begin
wi := Min(xe-xs + 1 + x,Self.w); wi := Min(xe-xs + 1 + x,Self.w);
hi := Min(ye-ys + 1 + y,Self.h); 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 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)); 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; end;

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

@ -30,9 +30,7 @@ interface
uses uses
Classes, SysUtils, MufasaTypes, Classes, SysUtils, MufasaTypes,
IOManager, Files, Finder, Bitmaps, dtm, ocr, Window, Input, Files, Finder, Bitmaps, dtm, ocr;
{$IFDEF MSWINDOWS} os_windows {$ENDIF}
{$IFDEF LINUX} os_linux {$ENDIF};
{ {
TClient is a full-blown instance of the MML. TClient is a full-blown instance of the MML.
@ -41,11 +39,12 @@ It binds all the components together.
type type
TClient = class(TObject) TClient = class(TObject)
constructor Create(plugin_dir: string); constructor Create;
destructor Destroy; override; destructor Destroy; override;
public public
IOManager: TIOManager; MWindow: TMWindow;
MInput: TMInput;
MFiles: TMFiles; MFiles: TMFiles;
MFinder: TMFinder; MFinder: TMFinder;
MBitmaps : TMBitmaps; MBitmaps : TMBitmaps;
@ -57,11 +56,12 @@ type
implementation implementation
// Possibly pass arguments to a default window. // Possibly pass arguments to a default window.
constructor TClient.Create(plugin_dir: string); constructor TClient.Create;
begin begin
inherited Create; inherited Create;
IOManager:= TIOManager.Create(plugin_dir); MWindow := TMWindow.Create;
MInput := TMInput.Create(MWindow);
MFiles := TMFiles.Create; MFiles := TMFiles.Create;
MFinder := TMFinder.Create(Self); MFinder := TMFinder.Create(Self);
MBitmaps := TMBitmaps.Create(self); MBitmaps := TMBitmaps.Create(self);
@ -76,7 +76,8 @@ begin
MBitmaps.Free; MBitmaps.Free;
MFinder.Free; MFinder.Free;
MFiles.Free; MFiles.Free;
IOManager.Free; MInput.Free;
MWindow.Free;
inherited; inherited;
end; 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 ' + raise Exception.createFMT('Any Find Function, you did not pass a ' +
'correct ys: %d.', [ys]); '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 if (w <> CachedWidth) or (h <> CachedHeight) then
UpdateCachedValues(w,h); UpdateCachedValues(w,h);
if xe >= w then if xe >= w then
@ -379,7 +379,7 @@ begin
dX := xe - xs; dX := xe - xs;
dY := ye - ys; dY := ye - ys;
ColorToRGB(Color, clR, clG, clB); 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; Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith; PtrInc := PtrData.IncPtrWith;
CCts := Self.CTS; CCts := Self.CTS;
@ -400,7 +400,7 @@ begin
end; end;
Inc(Ptr, PtrInc) Inc(Ptr, PtrInc)
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.CountColor(Color, xs, ys, xe, ye: Integer): Integer; function TMFinder.CountColor(Color, xs, ys, xe, ye: Integer): Integer;
@ -422,7 +422,7 @@ begin
//next, convert the color to r,g,b //next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); 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? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
@ -441,7 +441,7 @@ begin
Inc(Ptr, PtrInc) Inc(Ptr, PtrInc)
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColor(out x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean; 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 //next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); 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? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
@ -481,7 +481,7 @@ begin
x := xx; x := xx;
y := yy; y := yy;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
Exit; Exit;
end; end;
Inc(Ptr); Inc(Ptr);
@ -489,7 +489,7 @@ begin
Inc(Ptr, PtrInc) Inc(Ptr, PtrInc)
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColorSpiral(var x, y: Integer; color, xs, ys, xe, function TMFinder.FindColorSpiral(var x, y: Integer; color, xs, ys, xe,
@ -511,7 +511,7 @@ begin
//next, convert the color to r,g,b //next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); 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 //Load rowdata
RowData:= CalculateRowPtrs(ptrdata,dy+1); RowData:= CalculateRowPtrs(ptrdata,dy+1);
//Load the spiral path //Load the spiral path
@ -526,11 +526,11 @@ begin
Result := True; Result := True;
x := ClientTPA[i].x + xs; x := ClientTPA[i].x + xs;
y := ClientTPA[i].y + ys; y := ClientTPA[i].y + ys;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
Exit; Exit;
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColoredArea(var x, y: Integer; Color, xs, ys, xe, ye, MinArea: Integer): Boolean; 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 //next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); 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? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
@ -586,7 +586,7 @@ begin
Result := True; Result := True;
x := xx; x := xx;
y := yy; y := yy;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
Exit; Exit;
end; end;
end; end;
@ -604,7 +604,7 @@ begin
Inc(Ptr, PtrInc); Inc(Ptr, PtrInc);
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
@ -634,7 +634,7 @@ begin
if Cts = 2 then if Cts = 2 then
RGBToHSLNonFixed(clR,clG,clB,H1,S1,L1); 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? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
@ -730,14 +730,14 @@ begin
end; end;
end; end;
Result := False; Result := False;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
Exit; Exit;
Hit: Hit:
Result := True; Result := True;
x := xx; x := xx;
y := yy; y := yy;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColorTolerance(out x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean; function TMFinder.FindColorTolerance(out x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean;
@ -766,7 +766,7 @@ begin
if Cts = 2 then if Cts = 2 then
RGBToHSL(clR,clG,clB,H1,S1,L1); 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? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
@ -821,14 +821,14 @@ begin
end; end;
end; end;
Result := False; Result := False;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
Exit; Exit;
Hit: Hit:
Result := True; Result := True;
x := xx; x := xx;
y := yy; y := yy;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColoredAreaTolerance(var x, y: Integer; Color, xs, ys, xe, ye, MinArea, tol: Integer): Boolean; 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); ColorToRGB(Color, clR, clG, clB);
if Cts = 2 then if Cts = 2 then
RGBToHSL(clR,clG,clB,H1,S1,L1); 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? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
@ -899,14 +899,14 @@ begin
end; end;
Result := False; Result := False;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
Exit; Exit;
Hit: Hit:
Result := True; Result := True;
x := xx; x := xx;
y := yy; y := yy;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColorsTolerance(out Points: TPointArray; Color, xs, ys, function TMFinder.FindColorsTolerance(out Points: TPointArray; Color, xs, ys,
@ -930,7 +930,7 @@ begin
if CTS = 2 then if CTS = 2 then
ColorToHSL(color,H1,S1,L1); 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? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
@ -994,7 +994,7 @@ begin
SetLength(Points, C); SetLength(Points, C);
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
Result := C > 0; Result := C > 0;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColorsToleranceOptimised(out Points: TPointArray; Color, xs, ys, function TMFinder.FindColorsToleranceOptimised(out Points: TPointArray; Color, xs, ys,
xe, ye, Tol: Integer): Boolean; xe, ye, Tol: Integer): Boolean;
@ -1017,7 +1017,7 @@ begin
if CTS = 2 then if CTS = 2 then
RGBToHSLNonFixed(clR,clG,clB,H1,S1,L1); 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? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
@ -1122,7 +1122,7 @@ begin
SetLength(Points, C); SetLength(Points, C);
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
Result := C > 0; Result := C > 0;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColorsSpiralTolerance(x, y: Integer; function TMFinder.FindColorsSpiralTolerance(x, y: Integer;
@ -1144,7 +1144,7 @@ begin
ColorToRGB(Color, clR, clG, clB); ColorToRGB(Color, clR, clG, clB);
ColorToHSL(Color, H1, S1, L1); 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; c := 0;
@ -1199,7 +1199,7 @@ begin
SetLength(Points, C); SetLength(Points, C);
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
Result := C > 0; Result := C > 0;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColors(out TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean; function TMFinder.FindColors(out TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean;
@ -1220,7 +1220,7 @@ begin
ColorToRGB(Color, clR, clG, clB); 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; Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith; PtrInc := PtrData.IncPtrWith;
@ -1246,7 +1246,7 @@ begin
Result := I > 0; Result := I > 0;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
{ Only works with CTS 1 for now.. Since Colorsame doesn't return a boolean :-( } { Only works with CTS 1 for now.. Since Colorsame doesn't return a boolean :-( }
@ -1274,7 +1274,7 @@ begin
dX := xe - xs; dX := xe - xs;
dY := ye - ys; 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 //Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1); MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
@ -1321,12 +1321,12 @@ begin
//We have found the mask appearntly, otherwise we would have jumped! Gna Gna. //We have found the mask appearntly, otherwise we would have jumped! Gna Gna.
x := xx + xs; x := xx + xs;
y := yy + ys; y := yy + ys;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
Exit(true); Exit(true);
//Bah not found the mask, lets do nothing and continue! //Bah not found the mask, lets do nothing and continue!
NotFoundMask: NotFoundMask:
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
procedure TMFinder.CheckMask(Mask: TMask); procedure TMFinder.CheckMask(Mask: TMask);
@ -1339,7 +1339,7 @@ function TMFinder.FindBitmap(bitmap: TMufasaBitmap; out x, y: Integer): Boolean;
var var
w,h : integer; w,h : integer;
begin 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); result := Self.FindBitmapIn(bitmap,x,y,0,0,w-1,h-1);
end; end;
@ -1366,7 +1366,7 @@ begin
dX := xe - xs; dX := xe - xs;
dY := ye - ys; 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 //Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1); MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap); BmpRowData:= CalculateRowPtrs(bitmap);
@ -1393,14 +1393,14 @@ begin
end; end;
//We did find the Bmp, otherwise we would be at the part below //We did find the Bmp, otherwise we would be at the part below
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
x := xx + xs; x := xx + xs;
y := yy + ys; y := yy + ys;
result := true; result := true;
exit; exit;
NotFoundBmp: NotFoundBmp:
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, function TMFinder.FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs,
@ -1428,7 +1428,7 @@ begin
dX := xe - xs; dX := xe - xs;
dY := ye - ys; 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 //Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1); MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap); BmpRowData:= CalculateRowPtrs(bitmap);
@ -1462,14 +1462,14 @@ begin
end; end;
//We did find the Bmp, otherwise we would be at the part below //We did find the Bmp, otherwise we would be at the part below
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
x := xx + xs; x := xx + xs;
y := yy + ys; y := yy + ys;
result := true; result := true;
exit; exit;
NotFoundBmp: NotFoundBmp:
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer; function TMFinder.FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer;
@ -1495,7 +1495,7 @@ begin
dX := xe - xs; dX := xe - xs;
dY := ye - ys; 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 //Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1); MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap); BmpRowData:= CalculateRowPtrs(bitmap);
@ -1524,14 +1524,14 @@ begin
end; end;
//We did find the Bmp, otherwise we would be at the part below //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; x := ClientTPA[i].x + xs;
y := ClientTPA[i].y + ys; y := ClientTPA[i].y + ys;
result := true; result := true;
exit; exit;
NotFoundBmp: NotFoundBmp:
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x, function TMFinder.FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x,
@ -1559,7 +1559,7 @@ begin
dX := xe - xs; dX := xe - xs;
dY := ye - ys; 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 //Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1); MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap); BmpRowData:= CalculateRowPtrs(bitmap);
@ -1602,7 +1602,7 @@ begin
exit; exit;
NotFoundBmp: NotFoundBmp:
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, function TMFinder.FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x,
@ -1631,7 +1631,7 @@ begin
dX := xe - xs; dX := xe - xs;
dY := ye - ys; 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 //Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1); MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap); BmpRowData:= CalculateRowPtrs(bitmap);
@ -1680,7 +1680,7 @@ begin
SetLength(Points,FoundC); SetLength(Points,FoundC);
Move(ClientTPA[0], Points[0], FoundC * SizeOf(TPoint)); Move(ClientTPA[0], Points[0], FoundC * SizeOf(TPoint));
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x, function TMFinder.FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x,
@ -1715,7 +1715,7 @@ begin
dY := ye - ys; dY := ye - ys;
SearchDx := dX; SearchDx := dX;
SearchDy := dY; 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 //Caculate the row ptrs
MainRowdata:= CalculateRowPtrs(PtrData,dy+1); MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
BmpRowData:= CalculateRowPtrs(bitmap); BmpRowData:= CalculateRowPtrs(bitmap);
@ -1775,7 +1775,7 @@ begin
BestPT := Point(xx+xs,yy+ys); BestPT := Point(xx+xs,yy+ys);
if GoodCount = TotalC then if GoodCount = TotalC then
begin; begin;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
x := BestPT.x; x := BestPT.x;
y := BestPT.y; y := BestPT.y;
accuracy:= 1; accuracy:= 1;
@ -1783,7 +1783,7 @@ begin
end; end;
end; end;
end; end;
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
if BestCount = 0 then if BestCount = 0 then
Exit; Exit;
accuracy := BestCount / TotalC; accuracy := BestCount / TotalC;
@ -1880,7 +1880,7 @@ begin
C := DTM.c; C := DTM.c;
// Retreive Client Data. // 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); cd := CalculateRowPtrs(PtrData, h + 1);
//writeln(format('w,h: %d, %d', [w,h])); //writeln(format('w,h: %d, %d', [w,h]));
@ -1937,7 +1937,7 @@ begin
end; end;
TheEnd: TheEnd:
TClient(Client).IOManager.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
SetLength(Points, pc); SetLength(Points, pc);
if pc > 0 then 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 uses
Classes, SysUtils,plugins; Classes, SysUtils, LibLoader;
const const
DS = DirectorySeparator; DS = DirectorySeparator;
MEOL = {$ifdef MSWINDOWS}#13+{$endif}#10; MEOL = {$ifdef MSWINDOWS}#13+{$endif}#10;
@ -115,8 +115,6 @@ type
SubPoints: TDTMPointDefArray; SubPoints: TDTMPointDefArray;
end; end;
var
PluginsGlob : TMPlugins;
type type
VirtualKeyInfo = record VirtualKeyInfo = record
Str : string; Str : string;

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

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