From adcde2d2ba286a489566387b1e9b574ee1b56b54 Mon Sep 17 00:00:00 2001 From: BenLand100 Date: Thu, 21 Jan 2010 05:47:53 +0000 Subject: [PATCH] Implemented windows stuff, but as I can compile yet not debug windows on here, its still a bit buggy... git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@438 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- .../Projects/SAMufasaGUI/project1.lpi | 293 ++++++++++-------- .../Projects/SAMufasaGUI/project1.lpr | 7 +- .../Projects/SAMufasaGUI/testunit.pas | 4 +- .../Units/MMLAddon/PSInc/Wrappers/mouse.inc | 6 +- .../Units/MMLAddon/windowselector.pas | 5 +- .../iomanager/Units/MMLCore/iomanager.pas | 68 ++-- branches/iomanager/Units/MMLCore/os_linux.pas | 163 +++++++++- .../iomanager/Units/MMLCore/os_windows.pas | 230 ++++++++++++-- branches/iomanager/Units/MMLCore/window.pas | 5 +- 9 files changed, 566 insertions(+), 215 deletions(-) diff --git a/branches/iomanager/Projects/SAMufasaGUI/project1.lpi b/branches/iomanager/Projects/SAMufasaGUI/project1.lpi index 9466d49..ab17fdb 100644 --- a/branches/iomanager/Projects/SAMufasaGUI/project1.lpi +++ b/branches/iomanager/Projects/SAMufasaGUI/project1.lpi @@ -10,7 +10,7 @@ <UseXPManifest Value="True"/> - <ActiveEditorIndexAtStart Value="0"/> + <ActiveEditorIndexAtStart Value="11"/> </General> <VersionInfo> <ProjectVersion Value=""/> @@ -24,7 +24,7 @@ <RunParams> <local> <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + <LaunchingApplication PathPlusParams="$(TargetCmdLine)"/> </local> </RunParams> <RequiredPackages Count="2"> @@ -36,14 +36,16 @@ <PackageName Value="LCL"/> </Item2> </RequiredPackages> - <Units Count="285"> + <Units Count="287"> <Unit0> <Filename Value="project1.lpr"/> <IsPartOfProject Value="True"/> <UnitName Value="project1"/> - <CursorPos X="34" Y="35"/> - <TopLine Value="19"/> + <CursorPos X="12" Y="25"/> + <TopLine Value="15"/> + <EditorIndex Value="8"/> <UsageCount Value="205"/> + <Loaded Value="True"/> </Unit0> <Unit1> <Filename Value="unit1.pas"/> @@ -137,10 +139,9 @@ <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="TestUnit"/> - <ComponentState Value="1"/> - <CursorPos X="1" Y="1673"/> - <TopLine Value="1656"/> - <EditorIndex Value="0"/> + <CursorPos X="99" Y="1797"/> + <TopLine Value="1789"/> + <EditorIndex Value="11"/> <UsageCount Value="202"/> <Loaded Value="True"/> </Unit13> @@ -189,8 +190,8 @@ <IsPartOfProject Value="True"/> <UnitName Value="Client"/> <CursorPos X="47" Y="33"/> - <TopLine Value="16"/> - <EditorIndex Value="3"/> + <TopLine Value="23"/> + <EditorIndex Value="0"/> <UsageCount Value="201"/> <Loaded Value="True"/> </Unit20> @@ -198,9 +199,11 @@ <Filename Value="../../Units/MMLCore/mufasatypes.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="MufasaTypes"/> - <CursorPos X="58" Y="108"/> - <TopLine Value="92"/> + <CursorPos X="21" Y="33"/> + <TopLine Value="15"/> + <EditorIndex Value="2"/> <UsageCount Value="201"/> + <Loaded Value="True"/> </Unit21> <Unit22> <Filename Value="../../Units/MMLCore/files.pas"/> @@ -214,9 +217,9 @@ <Filename Value="../../Units/MMLCore/window.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="Window"/> - <CursorPos X="31" Y="59"/> - <TopLine Value="174"/> - <EditorIndex Value="8"/> + <CursorPos X="1" Y="163"/> + <TopLine Value="541"/> + <EditorIndex Value="14"/> <UsageCount Value="201"/> <Loaded Value="True"/> </Unit23> @@ -232,15 +235,17 @@ <UnitName Value="windowutil"/> <CursorPos X="14" Y="16"/> <TopLine Value="1"/> - <UsageCount Value="96"/> + <EditorIndex Value="5"/> + <UsageCount Value="100"/> + <Loaded Value="True"/> </Unit25> <Unit26> <Filename Value="../../Units/MMLCore/input.pas"/> <UnitName Value="Input"/> - <CursorPos X="1" Y="1"/> - <TopLine Value="1"/> - <EditorIndex Value="4"/> - <UsageCount Value="88"/> + <CursorPos X="1" Y="83"/> + <TopLine Value="56"/> + <EditorIndex Value="15"/> + <UsageCount Value="93"/> <Loaded Value="True"/> </Unit26> <Unit27> @@ -249,9 +254,7 @@ <UnitName Value="finder"/> <CursorPos X="10" Y="2000"/> <TopLine Value="1972"/> - <EditorIndex Value="14"/> <UsageCount Value="201"/> - <Loaded Value="True"/> </Unit27> <Unit28> <Filename Value="../../../lazarus/lcl/graphics.pp"/> @@ -271,9 +274,11 @@ <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="mmlpsthread"/> - <CursorPos X="5" Y="70"/> - <TopLine Value="470"/> + <CursorPos X="25" Y="261"/> + <TopLine Value="24"/> + <EditorIndex Value="3"/> <UsageCount Value="202"/> + <Loaded Value="True"/> </Unit30> <Unit31> <Filename Value="../../Units/PascalScript/uPSComponent.pas"/> @@ -353,9 +358,7 @@ <UnitName Value="bitmaps"/> <CursorPos X="22" Y="681"/> <TopLine Value="671"/> - <EditorIndex Value="13"/> <UsageCount Value="200"/> - <Loaded Value="True"/> </Unit42> <Unit43> <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.pp"/> @@ -368,9 +371,7 @@ <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/colour.inc"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <EditorIndex Value="12"/> <UsageCount Value="34"/> - <Loaded Value="True"/> </Unit44> <Unit45> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/bitmap.inc"/> @@ -490,23 +491,21 @@ <UnitName Value="colour_conv"/> <CursorPos X="1" Y="332"/> <TopLine Value="290"/> - <EditorIndex Value="15"/> <UsageCount Value="201"/> - <Loaded Value="True"/> </Unit62> <Unit63> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/mouse.inc"/> - <CursorPos X="67" Y="48"/> - <TopLine Value="31"/> - <UsageCount Value="6"/> + <CursorPos X="11" Y="26"/> + <TopLine Value="12"/> + <EditorIndex Value="7"/> + <UsageCount Value="15"/> + <Loaded Value="True"/> </Unit63> <Unit64> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/> <CursorPos X="1" Y="1"/> - <TopLine Value="1"/> - <EditorIndex Value="10"/> + <TopLine Value="90"/> <UsageCount Value="45"/> - <Loaded Value="True"/> </Unit64> <Unit65> <Filename Value="../../Units/PascalScript/uPSCompiler.pas"/> @@ -544,9 +543,11 @@ <Filename Value="../../Units/MMLAddon/plugins.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="plugins"/> - <CursorPos X="40" Y="49"/> - <TopLine Value="55"/> + <CursorPos X="3" Y="76"/> + <TopLine Value="59"/> + <EditorIndex Value="4"/> <UsageCount Value="200"/> + <Loaded Value="True"/> </Unit70> <Unit71> <Filename Value="../../Units/MMLAddon/PSInc/psdefines.inc"/> @@ -608,9 +609,7 @@ <UnitName Value="colourpicker"/> <CursorPos X="22" Y="229"/> <TopLine Value="217"/> - <EditorIndex Value="1"/> <UsageCount Value="201"/> - <Loaded Value="True"/> </Unit79> <Unit80> <Filename Value="../../../cogat/Units/CogatUnits/compdragger.pas"/> @@ -633,9 +632,9 @@ <Filename Value="../../Units/MMLAddon/windowselector.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="windowselector"/> - <CursorPos X="39" Y="99"/> - <TopLine Value="82"/> - <EditorIndex Value="2"/> + <CursorPos X="20" Y="199"/> + <TopLine Value="173"/> + <EditorIndex Value="10"/> <UsageCount Value="201"/> <Loaded Value="True"/> </Unit82> @@ -722,9 +721,7 @@ <UnitName Value="ocr"/> <CursorPos X="51" Y="474"/> <TopLine Value="457"/> - <EditorIndex Value="6"/> <UsageCount Value="200"/> - <Loaded Value="True"/> </Unit94> <Unit95> <Filename Value="../../Units/PascalScript/uPSR_extctrls.pas"/> @@ -1207,9 +1204,12 @@ <ComponentName Value="ColourHistoryForm"/> <ResourceBaseClass Value="Form"/> <UnitName Value="colourhistory"/> - <CursorPos X="43" Y="16"/> - <TopLine Value="1"/> + <ComponentState Value="1"/> + <CursorPos X="7" Y="73"/> + <TopLine Value="55"/> + <EditorIndex Value="9"/> <UsageCount Value="200"/> + <Loaded Value="True"/> </Unit166> <Unit167> <Filename Value="../../../Documents/lazarus/lcl/comctrls.pp"/> @@ -1322,9 +1322,11 @@ <Unit183> <Filename Value="../../Units/MMLCore/mmlkeyinput.pas"/> <UnitName Value="MMLKeyInput"/> - <CursorPos X="62" Y="31"/> - <TopLine Value="40"/> - <UsageCount Value="8"/> + <CursorPos X="36" Y="35"/> + <TopLine Value="23"/> + <EditorIndex Value="16"/> + <UsageCount Value="15"/> + <Loaded Value="True"/> </Unit183> <Unit184> <Filename Value="../../../Documents/lazarus/components/mouseandkeyinput/xkeyinput.pas"/> @@ -1376,9 +1378,11 @@ </Unit190> <Unit191> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/keyboard.inc"/> - <CursorPos X="13" Y="46"/> - <TopLine Value="26"/> - <UsageCount Value="2"/> + <CursorPos X="26" Y="43"/> + <TopLine Value="13"/> + <EditorIndex Value="6"/> + <UsageCount Value="15"/> + <Loaded Value="True"/> </Unit191> <Unit192> <Filename Value="../../../Documents/fpc/packages/x11/src/xlib.pp"/> @@ -1600,7 +1604,7 @@ <UnitName Value="framefunctionlist"/> <CursorPos X="26" Y="295"/> <TopLine Value="7"/> - <UsageCount Value="148"/> + <UsageCount Value="161"/> </Unit223> <Unit224> <Filename Value="../../../usr/local/share/lazarus/lcl/comctrls.pp"/> @@ -1655,7 +1659,7 @@ <UnitName Value="simpleanalyzer"/> <CursorPos X="52" Y="104"/> <TopLine Value="193"/> - <UsageCount Value="135"/> + <UsageCount Value="148"/> </Unit231> <Unit232> <Filename Value="../../Units/Misc/mPasLex.pas"/> @@ -1715,9 +1719,7 @@ <Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/> <CursorPos X="30" Y="109"/> <TopLine Value="98"/> - <EditorIndex Value="11"/> <UsageCount Value="23"/> - <Loaded Value="True"/> </Unit240> <Unit241> <Filename Value="../../Units/Synapse/synautil.pas"/> @@ -1732,7 +1734,7 @@ <UnitName Value="updater"/> <CursorPos X="38" Y="211"/> <TopLine Value="65"/> - <UsageCount Value="108"/> + <UsageCount Value="121"/> </Unit242> <Unit243> <Filename Value="updateform.pas"/> @@ -1740,11 +1742,10 @@ <ComponentName Value="SimbaUpdateForm"/> <ResourceBaseClass Value="Form"/> <UnitName Value="updateform"/> + <ComponentState Value="1"/> <CursorPos X="111" Y="102"/> - <TopLine Value="81"/> - <EditorIndex Value="9"/> - <UsageCount Value="103"/> - <Loaded Value="True"/> + <TopLine Value="207"/> + <UsageCount Value="116"/> </Unit243> <Unit244> <Filename Value="../../../Documents/lazarus/lcl/fileutil.pas"/> @@ -1865,7 +1866,7 @@ <UnitName Value="simbasettings"/> <CursorPos X="26" Y="9"/> <TopLine Value="11"/> - <UsageCount Value="66"/> + <UsageCount Value="79"/> </Unit261> <Unit262> <Filename Value="../../Units/MMLAddon/settings.pas"/> @@ -1910,7 +1911,7 @@ <UnitName Value="reportbug"/> <CursorPos X="53" Y="23"/> <TopLine Value="21"/> - <UsageCount Value="49"/> + <UsageCount Value="62"/> </Unit267> <Unit268> <Filename Value="../../Units/Synapse/synsock.pas"/> @@ -1967,7 +1968,7 @@ <UnitName Value="newinternets"/> <CursorPos X="80" Y="2"/> <TopLine Value="1"/> - <UsageCount Value="45"/> + <UsageCount Value="58"/> </Unit275> <Unit276> <Filename Value="reportbug.lrs"/> @@ -2013,19 +2014,19 @@ <Unit282> <Filename Value="../../Units/MMLCore/iomanager.pas"/> <UnitName Value="IOManager"/> - <CursorPos X="1" Y="229"/> - <TopLine Value="212"/> - <EditorIndex Value="5"/> - <UsageCount Value="14"/> + <CursorPos X="35" Y="6"/> + <TopLine Value="1"/> + <EditorIndex Value="1"/> + <UsageCount Value="19"/> <Loaded Value="True"/> </Unit282> <Unit283> <Filename Value="../../Units/MMLCore/os_linux.pas"/> <UnitName Value="os_linux"/> - <CursorPos X="40" Y="41"/> - <TopLine Value="12"/> - <EditorIndex Value="7"/> - <UsageCount Value="14"/> + <CursorPos X="10" Y="283"/> + <TopLine Value="270"/> + <EditorIndex Value="13"/> + <UsageCount Value="19"/> <Loaded Value="True"/> </Unit283> <Unit284> @@ -2035,123 +2036,139 @@ <TopLine Value="12"/> <UsageCount Value="12"/> </Unit284> + <Unit285> + <Filename Value="../../Units/MMLCore/os_windows.pas"/> + <UnitName Value="os_windows"/> + <CursorPos X="3" Y="290"/> + <TopLine Value="271"/> + <EditorIndex Value="12"/> + <UsageCount Value="15"/> + <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> </Units> <JumpHistory Count="29" HistoryIndex="28"> <Position1> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="155" Column="48" TopLine="139"/> + <Filename Value="../../Units/MMLCore/os_windows.pas"/> + <Caret Line="263" Column="26" TopLine="233"/> </Position1> <Position2> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="175" Column="5" TopLine="141"/> + <Filename Value="../../Units/MMLCore/os_windows.pas"/> + <Caret Line="256" Column="32" TopLine="239"/> </Position2> <Position3> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="151" Column="34" TopLine="130"/> + <Filename Value="../../Units/MMLCore/os_windows.pas"/> + <Caret Line="277" Column="14" TopLine="261"/> </Position3> <Position4> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="201" Column="24" TopLine="185"/> + <Filename Value="../../Units/MMLCore/os_windows.pas"/> + <Caret Line="303" Column="41" TopLine="272"/> </Position4> <Position5> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="271" Column="33" TopLine="254"/> + <Filename Value="testunit.pas"/> + <Caret Line="582" Column="60" TopLine="560"/> </Position5> <Position6> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="184" Column="39" TopLine="167"/> + <Filename Value="project1.lpr"/> + <Caret Line="49" Column="1" TopLine="16"/> </Position6> <Position7> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="288" Column="23" TopLine="271"/> + <Filename Value="project1.lpr"/> + <Caret Line="32" Column="3" TopLine="15"/> </Position7> <Position8> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="291" Column="18" TopLine="274"/> + <Filename Value="project1.lpr"/> + <Caret Line="49" Column="1" TopLine="16"/> </Position8> <Position9> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="298" Column="120" TopLine="281"/> + <Filename Value="colourhistory.pas"/> + <Caret Line="16" Column="43" TopLine="1"/> </Position9> <Position10> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="302" Column="32" TopLine="285"/> + <Filename Value="project1.lpr"/> + <Caret Line="49" Column="1" TopLine="16"/> </Position10> <Position11> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="173" Column="31" TopLine="156"/> + <Filename Value="testunit.pas"/> + <Caret Line="1543" Column="61" TopLine="1530"/> </Position11> <Position12> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="308" Column="43" TopLine="291"/> + <Filename Value="testunit.pas"/> + <Caret Line="1673" Column="101" TopLine="1656"/> </Position12> <Position13> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="384" Column="32" TopLine="367"/> + <Filename Value="testunit.pas"/> + <Caret Line="1733" Column="57" TopLine="1716"/> </Position13> <Position14> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="413" Column="39" TopLine="397"/> + <Filename Value="testunit.pas"/> + <Caret Line="1735" Column="36" TopLine="1716"/> </Position14> <Position15> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="449" Column="32" TopLine="418"/> + <Filename Value="testunit.pas"/> + <Caret Line="1741" Column="36" TopLine="1716"/> </Position15> <Position16> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="109" Column="79" TopLine="93"/> + <Filename Value="testunit.pas"/> + <Caret Line="1743" Column="21" TopLine="1716"/> </Position16> <Position17> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="236" Column="17" TopLine="220"/> + <Filename Value="testunit.pas"/> + <Caret Line="1747" Column="40" TopLine="1716"/> </Position17> <Position18> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="327" Column="105" TopLine="311"/> + <Filename Value="testunit.pas"/> + <Caret Line="1748" Column="38" TopLine="1716"/> </Position18> <Position19> - <Filename Value="../../Units/MMLCore/window.pas"/> - <Caret Line="163" Column="1" TopLine="145"/> + <Filename Value="testunit.pas"/> + <Caret Line="1750" Column="44" TopLine="1733"/> </Position19> <Position20> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="322" Column="32" TopLine="309"/> + <Filename Value="testunit.pas"/> + <Caret Line="1752" Column="24" TopLine="1733"/> </Position20> <Position21> - <Filename Value="../../Units/MMLAddon/windowselector.pas"/> - <Caret Line="99" Column="39" TopLine="82"/> + <Filename Value="testunit.pas"/> + <Caret Line="1764" Column="26" TopLine="1733"/> </Position21> <Position22> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="40" Column="49" TopLine="12"/> + <Filename Value="testunit.pas"/> + <Caret Line="1768" Column="42" TopLine="1751"/> </Position22> <Position23> - <Filename Value="../../Units/MMLAddon/windowselector.pas"/> - <Caret Line="51" Column="26" TopLine="33"/> + <Filename Value="testunit.pas"/> + <Caret Line="1786" Column="65" TopLine="1769"/> </Position23> <Position24> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="47" Column="30" TopLine="23"/> + <Filename Value="testunit.pas"/> + <Caret Line="1789" Column="31" TopLine="1769"/> </Position24> <Position25> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="32" Column="15" TopLine="23"/> + <Filename Value="testunit.pas"/> + <Caret Line="1791" Column="29" TopLine="1769"/> </Position25> <Position26> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="167" Column="21" TopLine="150"/> + <Filename Value="testunit.pas"/> + <Caret Line="1793" Column="29" TopLine="1769"/> </Position26> <Position27> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="154" Column="25" TopLine="144"/> + <Filename Value="testunit.pas"/> + <Caret Line="1794" Column="44" TopLine="1769"/> </Position27> <Position28> - <Filename Value="../../Units/MMLCore/os_linux.pas"/> - <Caret Line="41" Column="40" TopLine="12"/> + <Filename Value="testunit.pas"/> + <Caret Line="1795" Column="52" TopLine="1769"/> </Position28> <Position29> - <Filename Value="../../Units/MMLCore/iomanager.pas"/> - <Caret Line="229" Column="1" TopLine="212"/> + <Filename Value="testunit.pas"/> + <Caret Line="1796" Column="37" TopLine="1769"/> </Position29> </JumpHistory> </ProjectOptions> @@ -2162,14 +2179,24 @@ </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)/;$(ProjPath)../../Units/MMLAddon/PSInc/"/> - <OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;../../../fpc/packages/unixutil/src/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/;$(ProjPath)../../Units/Linux/;$(ProjPath)../../Units/Synapse/;$(LazarusDir)/components/mouseandkeyinput/;../../../fpc/packages/libc/src/"/> + <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)/"/> + <LCLWidgetType Value="win32"/> </SearchPaths> <CodeGeneration> + <TargetOS Value="Win32"/> <Optimizations> <VariablesInRegisters Value="True"/> <OptimizationLevel Value="2"/> </Optimizations> </CodeGeneration> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> <Other> <CustomOptions Value="-dUseCThreads -dM_MEMORY_DEBUG diff --git a/branches/iomanager/Projects/SAMufasaGUI/project1.lpr b/branches/iomanager/Projects/SAMufasaGUI/project1.lpr index ac88d62..10665ef 100644 --- a/branches/iomanager/Projects/SAMufasaGUI/project1.lpr +++ b/branches/iomanager/Projects/SAMufasaGUI/project1.lpr @@ -29,13 +29,12 @@ uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, cmem, {$ENDIF}{$ENDIF} - Interfaces, // this includes the LCL widgetset - LResources, Forms, testunit, colourhistory, About, internets, debugimage, + Interfaces, Forms, testunit, colourhistory, About, internets, debugimage, framefunctionlist, simpleanalyzer, updater, updateform, simbasettings; -{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF} + +{$R project1.res} begin - {$I project1.lrs} Application.Title:='Simba'; Application.Initialize; diff --git a/branches/iomanager/Projects/SAMufasaGUI/testunit.pas b/branches/iomanager/Projects/SAMufasaGUI/testunit.pas index 9d1283f..42eba47 100644 --- a/branches/iomanager/Projects/SAMufasaGUI/testunit.pas +++ b/branches/iomanager/Projects/SAMufasaGUI/testunit.pas @@ -574,7 +574,7 @@ begin Writeln('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now'); ScriptThread.SetPaths(ScriptPath,AppPath,Includepath,PluginsPath,fontPath); - ScriptThread.Client.IOManager.SetTarget(Selector.LastPick); + if selector.haspicked then ScriptThread.Client.IOManager.SetTarget(Selector.LastPick); loadFontsOnScriptStart := LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True'); @@ -1545,7 +1545,7 @@ end; procedure TForm1.ButtonSelectorDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - Manager.SetTarget(Selector.Drag {$ifdef MSWINDOWS},w_window{$endif}); + Manager.SetTarget(Selector.Drag); writeln('New window: ' + IntToStr(Selector.LastPick)); end; diff --git a/branches/iomanager/Units/MMLAddon/PSInc/Wrappers/mouse.inc b/branches/iomanager/Units/MMLAddon/PSInc/Wrappers/mouse.inc index af3f52b..495b98e 100644 --- a/branches/iomanager/Units/MMLAddon/PSInc/Wrappers/mouse.inc +++ b/branches/iomanager/Units/MMLAddon/PSInc/Wrappers/mouse.inc @@ -47,14 +47,12 @@ end; procedure HoldMouse(x, y: integer; clickType: integer); begin - CurrThread.Client.IOManager.SetMousePos(x, y); - CurrThread.Client.IOManager.MouseButtonAction(x, y, ConvIntClickType(clickType), mouse_Down); + CurrThread.Client.IOManager.HoldMouse(x, y, ConvIntClickType(clickType)); end; procedure ReleaseMouse(x, y: integer; clickType: integer); begin - CurrThread.Client.IOManager.SetMousePos(x, y); - CurrThread.Client.IOManager.MouseButtonAction(x, y, ConvIntClickType(clickType), mouse_Up); + CurrThread.Client.IOManager.ReleaseMouse(x, y, ConvIntClickType(clickType)); end; procedure ClickMouse(x, y: integer; clickType: integer); diff --git a/branches/iomanager/Units/MMLAddon/windowselector.pas b/branches/iomanager/Units/MMLAddon/windowselector.pas index d67d6d6..2d8887c 100644 --- a/branches/iomanager/Units/MMLAddon/windowselector.pas +++ b/branches/iomanager/Units/MMLAddon/windowselector.pas @@ -53,6 +53,7 @@ type public LastPick: TNativeWindow; + haspicked: boolean; manager: TIOManager; end; @@ -64,7 +65,7 @@ implementation constructor TMWindowSelector.Create(manager: TIOManager); begin inherited create; - + haspicked:= false; self.manager := manager; end; @@ -130,6 +131,7 @@ begin Result := Tempwindow; LastPick:= TempWindow; + haspicked:= true; end; XFlush(manager.display); Sleep(16); @@ -194,6 +196,7 @@ begin; end; Result := TempHandle; LastPick:= TempHandle; + haspicked:= true; Screen.Cursor:= cursor; Invalidaterect(temphandle, nil, true); UpdateWindow(temphandle); diff --git a/branches/iomanager/Units/MMLCore/iomanager.pas b/branches/iomanager/Units/MMLCore/iomanager.pas index 7d6c451..f364461 100644 --- a/branches/iomanager/Units/MMLCore/iomanager.pas +++ b/branches/iomanager/Units/MMLCore/iomanager.pas @@ -18,18 +18,19 @@ interface 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 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; left: boolean); virtual; - procedure ReleaseMouse(x,y: integer; left: boolean); 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: PChar); virtual; + procedure SendString(str: string); virtual; procedure HoldKey(key: integer); virtual; procedure ReleaseKey(key: integer); virtual; function IsKeyHeld(key: integer): boolean; virtual; @@ -57,12 +58,13 @@ interface 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; left: boolean); override; abstract; - procedure ReleaseMouse(x,y: integer; left: boolean); override; abstract; + procedure HoldMouse(x,y: integer; button: TClickType); override; abstract; + procedure ReleaseMouse(x,y: integer; button: TClickType); override; abstract; - procedure SendString(str: PChar); 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; @@ -111,10 +113,10 @@ interface procedure GetMousePosition(var x,y: integer); override; procedure MoveMouse(x,y: integer); override; - procedure HoldMouse(x,y: integer; left: boolean); override; - procedure ReleaseMouse(x,y: integer; left: boolean); override; + procedure HoldMouse(x,y: integer; button: TClickType); override; + procedure ReleaseMouse(x,y: integer; button: TClickType); override; - procedure SendString(str: PChar); override; + procedure SendString(str: string); override; procedure HoldKey(key: integer); override; procedure ReleaseKey(key: integer); override; function IsKeyHeld(key: integer): boolean; override; @@ -185,9 +187,9 @@ interface procedure GetMousePos(var X, Y: Integer); procedure SetMousePos(X, Y: Integer); - procedure MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress); - procedure MouseButtonActionSilent(x,y : integer; mClick: TClickType; mPress: TMousePress); - procedure ClickMouse(X, Y: Integer; mClick: TClickType); + 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); @@ -324,13 +326,18 @@ implementation 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.MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress); begin {lolwat} end; - procedure TIOManager_Abstract.MouseButtonActionSilent(x,y : integer; mClick: TClickType; mPress: TMousePress); begin {lolwat} end; - procedure TIOManager_Abstract.ClickMouse(X, Y: Integer; mClick: TClickType); begin {lolwat} 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 {lolwat} 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; @@ -345,13 +352,14 @@ implementation 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; left: boolean); begin raise Exception.Create('HoldMouse not avaliable for this target'); end; - procedure TTarget.ReleaseMouse(x,y: integer; left: boolean); begin raise Exception.Create('ReleaseMouse 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: PChar); begin raise Exception.Create('SendString 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; @@ -383,10 +391,24 @@ implementation procedure TEIOS_Target.GetMousePosition(var x,y: integer); begin client.GetMousePosition(target,x,y); end; procedure TEIOS_Target.MoveMouse(x,y: integer); begin client.MoveMouse(target,x,y); end; - procedure TEIOS_Target.HoldMouse(x,y: integer; left: boolean); begin client.HoldMouse(target,x,y,left); end; - procedure TEIOS_Target.ReleaseMouse(x,y: integer; left: boolean); begin client.ReleaseMouse(target,x,y,left); end; + procedure TEIOS_Target.HoldMouse(x,y: integer; button: TClickType); + 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; + procedure TEIOS_Target.ReleaseMouse(x,y: integer; button: TClickType); + 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; - procedure TEIOS_Target.SendString(str: PChar); begin client.SendString(target,str); end; + procedure TEIOS_Target.SendString(str: string); begin client.SendString(target,PChar(@str[1])); end; procedure TEIOS_Target.HoldKey(key: integer); begin client.HoldKey(target,key); end; procedure TEIOS_Target.ReleaseKey(key: integer); begin client.ReleaseKey(target,key); end; function TEIOS_Target.IsKeyHeld(key: integer): boolean; begin result:= client.IsKeyHeld(target,key); end; diff --git a/branches/iomanager/Units/MMLCore/os_linux.pas b/branches/iomanager/Units/MMLCore/os_linux.pas index 9bb02bc..a85d9d8 100644 --- a/branches/iomanager/Units/MMLCore/os_linux.pas +++ b/branches/iomanager/Units/MMLCore/os_linux.pas @@ -3,12 +3,18 @@ unit os_linux; interface uses - Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager; + 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); @@ -17,12 +23,13 @@ interface 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; left: boolean); override; - procedure ReleaseMouse(x,y: integer; left: boolean); override; + procedure HoldMouse(x,y: integer; button: TClickType); override; + procedure ReleaseMouse(x,y: integer; button: TClickType); override; - procedure SendString(str: PChar); override; + procedure SendString(str: string); override; procedure HoldKey(key: integer); override; procedure ReleaseKey(key: integer); override; function IsKeyHeld(key: integer): boolean; override; @@ -32,6 +39,7 @@ interface window: x.TWindow; buffer: PXImage; dirty: Boolean; //true if image loaded + keyinput: TKeyInput; end; TIOManager = class(TIOManager_Abstract) @@ -51,7 +59,19 @@ interface implementation - uses windowutil, GraphType; + uses windowutil, GraphType, interfacebase, lcltype; + +//***implementation*** TKeyInput + + procedure TKeyInput.Down(Key: Word); + begin + DoDown(Key); + end; + + procedure TKeyInput.Up(Key: Word); + begin + DoUp(Key); + end; //***implementation*** TWindow @@ -61,12 +81,14 @@ implementation self.display:= display; self.screennum:= screennum; self.window:= window; - self.dirty:= false; + self.dirty:= false; + self.keyinput:= TKeyInput.Create end; destructor TWindow.Destroy; begin - FreeReturnData; + FreeReturnData; + keyinput.Free; inherited Destroy; end; @@ -92,6 +114,17 @@ implementation 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 @@ -136,15 +169,115 @@ implementation end; end; - procedure TWindow.GetMousePosition(var x,y: integer); begin end; - procedure TWindow.MoveMouse(x,y: integer); begin end; - procedure TWindow.HoldMouse(x,y: integer; left: boolean); begin end; - procedure TWindow.ReleaseMouse(x,y: integer; left: boolean); begin 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; - procedure TWindow.SendString(str: PChar); begin end; - procedure TWindow.HoldKey(key: integer); begin end; - procedure TWindow.ReleaseKey(key: integer); begin end; - function TWindow.IsKeyHeld(key: integer): boolean; begin 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 diff --git a/branches/iomanager/Units/MMLCore/os_windows.pas b/branches/iomanager/Units/MMLCore/os_windows.pas index 5733f3f..6d6233c 100644 --- a/branches/iomanager/Units/MMLCore/os_windows.pas +++ b/branches/iomanager/Units/MMLCore/os_windows.pas @@ -3,10 +3,18 @@ unit os_windows; interface uses - Classes, SysUtils, mufasatypes, windows, IOManager; + 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); @@ -15,58 +23,127 @@ interface 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; left: boolean); override; - procedure ReleaseMouse(x,y: integer; left: boolean); override; + procedure HoldMouse(x,y: integer; button: TClickType); override; + procedure ReleaseMouse(x,y: integer; button: TClickType); override; - procedure SendString(str: PChar); override; + procedure SendString(str: string); override; procedure HoldKey(key: integer); override; procedure ReleaseKey(key: integer); override; function IsKeyHeld(key: integer): boolean; override; private - procedure ValidateBuffer(w,h:integer); 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); - destructor Destroy; override function SetTarget(target: Hwnd): integer; overload; - procedure SetDesktop; - private + procedure SetDesktop; override; + protected + DesktopHWND : Hwnd; procedure NativeInit; override; procedure NativeFree; override; - DesktopHWND : Hwnd; end; implementation + uses windowutil, 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.dc:= GetDC(hwnd); + inherited Create; + self.handle:= target; + self.dc:= GetDC(target); self.buffer:= TBitmap.Create; self.buffer.PixelFormat:= pf32bit; + keyinput:= TKeyInput.Create; end; destructor TWindow.Destroy; begin - ReleaseDC(hwnd,dc); + 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(self.hwnd, Rect); + GetWindowRect(handle, Rect); w:= Rect.Right - Rect.Left; h:= Rect.Bottom - Rect.Top; end; @@ -77,13 +154,15 @@ implementation end; procedure TWindow.ValidateBuffer(w,h:integer); + var + BmpInfo : Windows.TBitmap; begin if (w <> self.width) or (height <> self.height) then begin - DrawBitmap.SetSize(w,h); + buffer.SetSize(w,h); self.width:= w; self.height:= h; - GetObject(DrawBitmap.Handle, SizeOf(BmpInfo), @BmpInfo); + GetObject(buffer.Handle, SizeOf(BmpInfo), @BmpInfo); self.buffer_raw := BmpInfo.bmBits; end; end; @@ -93,7 +172,7 @@ implementation temp: PRGB32; w,h : integer; begin - GetDimensions(w,h); + 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]); @@ -103,19 +182,112 @@ implementation Result.RowLen:= w; end; - procedure TWindow.GetMousePosition(var x,y: integer); begin end; - procedure TWindow.MoveMouse(x,y: integer); begin end; - procedure TWindow.HoldMouse(x,y: integer; left: boolean); begin end; - procedure TWindow.ReleaseMouse(x,y: integer; left: boolean); begin 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: PChar); begin end; - procedure TWindow.HoldKey(key: integer); begin end; - procedure TWindow.ReleaseKey(key: integer); begin end; - function TWindow.IsKeyHeld(key: integer): boolean; begin 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; @@ -132,7 +304,7 @@ implementation function TIOManager.SetTarget(target: Hwnd): integer; begin - SetBothTargets(TWindow.Create(hwnd)); + SetBothTargets(TWindow.Create(target)); end; - - + +end. diff --git a/branches/iomanager/Units/MMLCore/window.pas b/branches/iomanager/Units/MMLCore/window.pas index 9b216ef..ee4ef15 100644 --- a/branches/iomanager/Units/MMLCore/window.pas +++ b/branches/iomanager/Units/MMLCore/window.pas @@ -160,10 +160,7 @@ type implementation -uses - windowutil, // For utilities such as XImageToRawImage - GraphType // For TRawImage - ; +uses windowutil, GraphType; constructor TMWindow.Create; begin