mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-25 18:52:15 -05:00
Removed old units, now fully dependant on new units. Windows still needs debugging --- or maybe its my crosscompiler that's fucked.
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@439 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
BenLand100
parent
adcde2d2ba
commit
d74ca8dd61
@ -1,3 +1,5 @@
|
|||||||
|
{ 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'
|
||||||
|
|||||||
@ -59,7 +59,7 @@ var
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
MufasaTypes, math,windowutil,graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
|
MufasaTypes, math, graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
|
||||||
{ TDebugImgForm }
|
{ TDebugImgForm }
|
||||||
|
|
||||||
procedure TDebugImgForm.FormCreate(Sender: TObject);
|
procedure TDebugImgForm.FormCreate(Sender: TObject);
|
||||||
|
|||||||
@ -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="1"/>
|
||||||
</General>
|
</General>
|
||||||
<VersionInfo>
|
<VersionInfo>
|
||||||
<ProjectVersion Value=""/>
|
<ProjectVersion Value=""/>
|
||||||
@ -36,14 +36,14 @@
|
|||||||
<PackageName Value="LCL"/>
|
<PackageName Value="LCL"/>
|
||||||
</Item2>
|
</Item2>
|
||||||
</RequiredPackages>
|
</RequiredPackages>
|
||||||
<Units Count="287">
|
<Units Count="288">
|
||||||
<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="12" Y="25"/>
|
||||||
<TopLine Value="15"/>
|
<TopLine Value="15"/>
|
||||||
<EditorIndex Value="8"/>
|
<EditorIndex Value="6"/>
|
||||||
<UsageCount Value="205"/>
|
<UsageCount Value="205"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit0>
|
</Unit0>
|
||||||
@ -141,7 +141,7 @@
|
|||||||
<UnitName Value="TestUnit"/>
|
<UnitName Value="TestUnit"/>
|
||||||
<CursorPos X="99" Y="1797"/>
|
<CursorPos X="99" Y="1797"/>
|
||||||
<TopLine Value="1789"/>
|
<TopLine Value="1789"/>
|
||||||
<EditorIndex Value="11"/>
|
<EditorIndex Value="10"/>
|
||||||
<UsageCount Value="202"/>
|
<UsageCount Value="202"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit13>
|
</Unit13>
|
||||||
@ -219,9 +219,7 @@
|
|||||||
<UnitName Value="Window"/>
|
<UnitName Value="Window"/>
|
||||||
<CursorPos X="1" Y="163"/>
|
<CursorPos X="1" Y="163"/>
|
||||||
<TopLine Value="541"/>
|
<TopLine Value="541"/>
|
||||||
<EditorIndex Value="14"/>
|
|
||||||
<UsageCount Value="201"/>
|
<UsageCount Value="201"/>
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit23>
|
</Unit23>
|
||||||
<Unit24>
|
<Unit24>
|
||||||
<Filename Value="../../../cogat/Units/CogatUnits/comptypes.pas"/>
|
<Filename Value="../../../cogat/Units/CogatUnits/comptypes.pas"/>
|
||||||
@ -233,20 +231,16 @@
|
|||||||
<Unit25>
|
<Unit25>
|
||||||
<Filename Value="../../Units/MMLCore/windowutil.pas"/>
|
<Filename Value="../../Units/MMLCore/windowutil.pas"/>
|
||||||
<UnitName Value="windowutil"/>
|
<UnitName Value="windowutil"/>
|
||||||
<CursorPos X="14" Y="16"/>
|
<CursorPos X="1" Y="27"/>
|
||||||
<TopLine Value="1"/>
|
<TopLine Value="12"/>
|
||||||
<EditorIndex Value="5"/>
|
|
||||||
<UsageCount Value="100"/>
|
<UsageCount Value="100"/>
|
||||||
<Loaded Value="True"/>
|
|
||||||
</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="1" Y="83"/>
|
||||||
<TopLine Value="56"/>
|
<TopLine Value="56"/>
|
||||||
<EditorIndex Value="15"/>
|
|
||||||
<UsageCount Value="93"/>
|
<UsageCount Value="93"/>
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit26>
|
</Unit26>
|
||||||
<Unit27>
|
<Unit27>
|
||||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||||
@ -274,11 +268,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="25" Y="261"/>
|
<CursorPos X="17" Y="131"/>
|
||||||
<TopLine Value="24"/>
|
<TopLine Value="2"/>
|
||||||
<EditorIndex Value="3"/>
|
|
||||||
<UsageCount Value="202"/>
|
<UsageCount Value="202"/>
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit30>
|
</Unit30>
|
||||||
<Unit31>
|
<Unit31>
|
||||||
<Filename Value="../../Units/PascalScript/uPSComponent.pas"/>
|
<Filename Value="../../Units/PascalScript/uPSComponent.pas"/>
|
||||||
@ -356,8 +348,8 @@
|
|||||||
<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="22" Y="681"/>
|
<CursorPos X="85" Y="113"/>
|
||||||
<TopLine Value="671"/>
|
<TopLine Value="94"/>
|
||||||
<UsageCount Value="200"/>
|
<UsageCount Value="200"/>
|
||||||
</Unit42>
|
</Unit42>
|
||||||
<Unit43>
|
<Unit43>
|
||||||
@ -497,8 +489,8 @@
|
|||||||
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/mouse.inc"/>
|
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/mouse.inc"/>
|
||||||
<CursorPos X="11" Y="26"/>
|
<CursorPos X="11" Y="26"/>
|
||||||
<TopLine Value="12"/>
|
<TopLine Value="12"/>
|
||||||
<EditorIndex Value="7"/>
|
<EditorIndex Value="5"/>
|
||||||
<UsageCount Value="15"/>
|
<UsageCount Value="16"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit63>
|
</Unit63>
|
||||||
<Unit64>
|
<Unit64>
|
||||||
@ -543,9 +535,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="3" Y="76"/>
|
<CursorPos X="12" Y="68"/>
|
||||||
<TopLine Value="59"/>
|
<TopLine Value="1"/>
|
||||||
<EditorIndex Value="4"/>
|
<EditorIndex Value="3"/>
|
||||||
<UsageCount Value="200"/>
|
<UsageCount Value="200"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit70>
|
</Unit70>
|
||||||
@ -632,9 +624,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="20" Y="199"/>
|
<CursorPos X="37" Y="34"/>
|
||||||
<TopLine Value="173"/>
|
<TopLine Value="12"/>
|
||||||
<EditorIndex Value="10"/>
|
<EditorIndex Value="8"/>
|
||||||
<UsageCount Value="201"/>
|
<UsageCount Value="201"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit82>
|
</Unit82>
|
||||||
@ -1207,7 +1199,7 @@
|
|||||||
<ComponentState Value="1"/>
|
<ComponentState Value="1"/>
|
||||||
<CursorPos X="7" Y="73"/>
|
<CursorPos X="7" Y="73"/>
|
||||||
<TopLine Value="55"/>
|
<TopLine Value="55"/>
|
||||||
<EditorIndex Value="9"/>
|
<EditorIndex Value="7"/>
|
||||||
<UsageCount Value="200"/>
|
<UsageCount Value="200"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit166>
|
</Unit166>
|
||||||
@ -1324,9 +1316,7 @@
|
|||||||
<UnitName Value="MMLKeyInput"/>
|
<UnitName Value="MMLKeyInput"/>
|
||||||
<CursorPos X="36" Y="35"/>
|
<CursorPos X="36" Y="35"/>
|
||||||
<TopLine Value="23"/>
|
<TopLine Value="23"/>
|
||||||
<EditorIndex Value="16"/>
|
|
||||||
<UsageCount Value="15"/>
|
<UsageCount Value="15"/>
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit183>
|
</Unit183>
|
||||||
<Unit184>
|
<Unit184>
|
||||||
<Filename Value="../../../Documents/lazarus/components/mouseandkeyinput/xkeyinput.pas"/>
|
<Filename Value="../../../Documents/lazarus/components/mouseandkeyinput/xkeyinput.pas"/>
|
||||||
@ -1380,8 +1370,8 @@
|
|||||||
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/keyboard.inc"/>
|
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/keyboard.inc"/>
|
||||||
<CursorPos X="26" Y="43"/>
|
<CursorPos X="26" Y="43"/>
|
||||||
<TopLine Value="13"/>
|
<TopLine Value="13"/>
|
||||||
<EditorIndex Value="6"/>
|
<EditorIndex Value="4"/>
|
||||||
<UsageCount Value="15"/>
|
<UsageCount Value="16"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit191>
|
</Unit191>
|
||||||
<Unit192>
|
<Unit192>
|
||||||
@ -1494,9 +1484,11 @@
|
|||||||
<ComponentName Value="DebugImgForm"/>
|
<ComponentName Value="DebugImgForm"/>
|
||||||
<ResourceBaseClass Value="Form"/>
|
<ResourceBaseClass Value="Form"/>
|
||||||
<UnitName Value="debugimage"/>
|
<UnitName Value="debugimage"/>
|
||||||
<CursorPos X="66" Y="17"/>
|
<CursorPos X="1" Y="1"/>
|
||||||
<TopLine Value="1"/>
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="9"/>
|
||||||
<UsageCount Value="202"/>
|
<UsageCount Value="202"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
</Unit207>
|
</Unit207>
|
||||||
<Unit208>
|
<Unit208>
|
||||||
<Filename Value="debugimage.lrs"/>
|
<Filename Value="debugimage.lrs"/>
|
||||||
@ -1604,7 +1596,7 @@
|
|||||||
<UnitName Value="framefunctionlist"/>
|
<UnitName Value="framefunctionlist"/>
|
||||||
<CursorPos X="26" Y="295"/>
|
<CursorPos X="26" Y="295"/>
|
||||||
<TopLine Value="7"/>
|
<TopLine Value="7"/>
|
||||||
<UsageCount Value="161"/>
|
<UsageCount Value="162"/>
|
||||||
</Unit223>
|
</Unit223>
|
||||||
<Unit224>
|
<Unit224>
|
||||||
<Filename Value="../../../usr/local/share/lazarus/lcl/comctrls.pp"/>
|
<Filename Value="../../../usr/local/share/lazarus/lcl/comctrls.pp"/>
|
||||||
@ -1659,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="148"/>
|
<UsageCount Value="149"/>
|
||||||
</Unit231>
|
</Unit231>
|
||||||
<Unit232>
|
<Unit232>
|
||||||
<Filename Value="../../Units/Misc/mPasLex.pas"/>
|
<Filename Value="../../Units/Misc/mPasLex.pas"/>
|
||||||
@ -1717,8 +1709,8 @@
|
|||||||
</Unit239>
|
</Unit239>
|
||||||
<Unit240>
|
<Unit240>
|
||||||
<Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/>
|
<Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/>
|
||||||
<CursorPos X="30" Y="109"/>
|
<CursorPos X="25" Y="163"/>
|
||||||
<TopLine Value="98"/>
|
<TopLine Value="154"/>
|
||||||
<UsageCount Value="23"/>
|
<UsageCount Value="23"/>
|
||||||
</Unit240>
|
</Unit240>
|
||||||
<Unit241>
|
<Unit241>
|
||||||
@ -1734,7 +1726,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="121"/>
|
<UsageCount Value="122"/>
|
||||||
</Unit242>
|
</Unit242>
|
||||||
<Unit243>
|
<Unit243>
|
||||||
<Filename Value="updateform.pas"/>
|
<Filename Value="updateform.pas"/>
|
||||||
@ -1745,7 +1737,7 @@
|
|||||||
<ComponentState Value="1"/>
|
<ComponentState Value="1"/>
|
||||||
<CursorPos X="111" Y="102"/>
|
<CursorPos X="111" Y="102"/>
|
||||||
<TopLine Value="207"/>
|
<TopLine Value="207"/>
|
||||||
<UsageCount Value="116"/>
|
<UsageCount Value="117"/>
|
||||||
</Unit243>
|
</Unit243>
|
||||||
<Unit244>
|
<Unit244>
|
||||||
<Filename Value="../../../Documents/lazarus/lcl/fileutil.pas"/>
|
<Filename Value="../../../Documents/lazarus/lcl/fileutil.pas"/>
|
||||||
@ -1866,7 +1858,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="79"/>
|
<UsageCount Value="80"/>
|
||||||
</Unit261>
|
</Unit261>
|
||||||
<Unit262>
|
<Unit262>
|
||||||
<Filename Value="../../Units/MMLAddon/settings.pas"/>
|
<Filename Value="../../Units/MMLAddon/settings.pas"/>
|
||||||
@ -1911,7 +1903,7 @@
|
|||||||
<UnitName Value="reportbug"/>
|
<UnitName Value="reportbug"/>
|
||||||
<CursorPos X="53" Y="23"/>
|
<CursorPos X="53" Y="23"/>
|
||||||
<TopLine Value="21"/>
|
<TopLine Value="21"/>
|
||||||
<UsageCount Value="62"/>
|
<UsageCount Value="63"/>
|
||||||
</Unit267>
|
</Unit267>
|
||||||
<Unit268>
|
<Unit268>
|
||||||
<Filename Value="../../Units/Synapse/synsock.pas"/>
|
<Filename Value="../../Units/Synapse/synsock.pas"/>
|
||||||
@ -1968,7 +1960,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="58"/>
|
<UsageCount Value="59"/>
|
||||||
</Unit275>
|
</Unit275>
|
||||||
<Unit276>
|
<Unit276>
|
||||||
<Filename Value="reportbug.lrs"/>
|
<Filename Value="reportbug.lrs"/>
|
||||||
@ -2014,19 +2006,19 @@
|
|||||||
<Unit282>
|
<Unit282>
|
||||||
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
|
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
|
||||||
<UnitName Value="IOManager"/>
|
<UnitName Value="IOManager"/>
|
||||||
<CursorPos X="35" Y="6"/>
|
<CursorPos X="11" Y="21"/>
|
||||||
<TopLine Value="1"/>
|
<TopLine Value="1"/>
|
||||||
<EditorIndex Value="1"/>
|
<EditorIndex Value="1"/>
|
||||||
<UsageCount Value="19"/>
|
<UsageCount Value="20"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit282>
|
</Unit282>
|
||||||
<Unit283>
|
<Unit283>
|
||||||
<Filename Value="../../Units/MMLCore/os_linux.pas"/>
|
<Filename Value="../../Units/MMLCore/os_linux.pas"/>
|
||||||
<UnitName Value="os_linux"/>
|
<UnitName Value="os_linux"/>
|
||||||
<CursorPos X="10" Y="283"/>
|
<CursorPos X="5" Y="21"/>
|
||||||
<TopLine Value="270"/>
|
<TopLine Value="1"/>
|
||||||
<EditorIndex Value="13"/>
|
<EditorIndex Value="12"/>
|
||||||
<UsageCount Value="19"/>
|
<UsageCount Value="20"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit283>
|
</Unit283>
|
||||||
<Unit284>
|
<Unit284>
|
||||||
@ -2039,10 +2031,10 @@
|
|||||||
<Unit285>
|
<Unit285>
|
||||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
||||||
<UnitName Value="os_windows"/>
|
<UnitName Value="os_windows"/>
|
||||||
<CursorPos X="3" Y="290"/>
|
<CursorPos X="4" Y="21"/>
|
||||||
<TopLine Value="271"/>
|
<TopLine Value="1"/>
|
||||||
<EditorIndex Value="12"/>
|
<EditorIndex Value="11"/>
|
||||||
<UsageCount Value="15"/>
|
<UsageCount Value="16"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit285>
|
</Unit285>
|
||||||
<Unit286>
|
<Unit286>
|
||||||
@ -2052,124 +2044,107 @@
|
|||||||
<TopLine Value="164"/>
|
<TopLine Value="164"/>
|
||||||
<UsageCount Value="10"/>
|
<UsageCount Value="10"/>
|
||||||
</Unit286>
|
</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="29" HistoryIndex="28">
|
<JumpHistory Count="23" HistoryIndex="22">
|
||||||
<Position1>
|
<Position1>
|
||||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
<Filename Value="colourhistory.pas"/>
|
||||||
<Caret Line="263" Column="26" TopLine="233"/>
|
<Caret Line="16" Column="43" TopLine="1"/>
|
||||||
</Position1>
|
</Position1>
|
||||||
<Position2>
|
<Position2>
|
||||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
<Filename Value="project1.lpr"/>
|
||||||
<Caret Line="256" Column="32" TopLine="239"/>
|
<Caret Line="49" Column="1" TopLine="16"/>
|
||||||
</Position2>
|
</Position2>
|
||||||
<Position3>
|
<Position3>
|
||||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="277" Column="14" TopLine="261"/>
|
<Caret Line="1543" Column="61" TopLine="1530"/>
|
||||||
</Position3>
|
</Position3>
|
||||||
<Position4>
|
<Position4>
|
||||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="303" Column="41" TopLine="272"/>
|
<Caret Line="1673" Column="101" TopLine="1656"/>
|
||||||
</Position4>
|
</Position4>
|
||||||
<Position5>
|
<Position5>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="582" Column="60" TopLine="560"/>
|
<Caret Line="1733" Column="57" TopLine="1716"/>
|
||||||
</Position5>
|
</Position5>
|
||||||
<Position6>
|
<Position6>
|
||||||
<Filename Value="project1.lpr"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="49" Column="1" TopLine="16"/>
|
<Caret Line="1735" Column="36" TopLine="1716"/>
|
||||||
</Position6>
|
</Position6>
|
||||||
<Position7>
|
<Position7>
|
||||||
<Filename Value="project1.lpr"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="32" Column="3" TopLine="15"/>
|
<Caret Line="1741" Column="36" TopLine="1716"/>
|
||||||
</Position7>
|
</Position7>
|
||||||
<Position8>
|
<Position8>
|
||||||
<Filename Value="project1.lpr"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="49" Column="1" TopLine="16"/>
|
<Caret Line="1743" Column="21" TopLine="1716"/>
|
||||||
</Position8>
|
</Position8>
|
||||||
<Position9>
|
<Position9>
|
||||||
<Filename Value="colourhistory.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="16" Column="43" TopLine="1"/>
|
<Caret Line="1747" Column="40" TopLine="1716"/>
|
||||||
</Position9>
|
</Position9>
|
||||||
<Position10>
|
<Position10>
|
||||||
<Filename Value="project1.lpr"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="49" Column="1" TopLine="16"/>
|
<Caret Line="1748" Column="38" TopLine="1716"/>
|
||||||
</Position10>
|
</Position10>
|
||||||
<Position11>
|
<Position11>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1543" Column="61" TopLine="1530"/>
|
<Caret Line="1750" Column="44" TopLine="1733"/>
|
||||||
</Position11>
|
</Position11>
|
||||||
<Position12>
|
<Position12>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1673" Column="101" TopLine="1656"/>
|
<Caret Line="1752" Column="24" TopLine="1733"/>
|
||||||
</Position12>
|
</Position12>
|
||||||
<Position13>
|
<Position13>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1733" Column="57" TopLine="1716"/>
|
<Caret Line="1764" Column="26" TopLine="1733"/>
|
||||||
</Position13>
|
</Position13>
|
||||||
<Position14>
|
<Position14>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1735" Column="36" TopLine="1716"/>
|
<Caret Line="1768" Column="42" TopLine="1751"/>
|
||||||
</Position14>
|
</Position14>
|
||||||
<Position15>
|
<Position15>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1741" Column="36" TopLine="1716"/>
|
<Caret Line="1786" Column="65" TopLine="1769"/>
|
||||||
</Position15>
|
</Position15>
|
||||||
<Position16>
|
<Position16>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1743" Column="21" TopLine="1716"/>
|
<Caret Line="1789" Column="31" TopLine="1769"/>
|
||||||
</Position16>
|
</Position16>
|
||||||
<Position17>
|
<Position17>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1747" Column="40" TopLine="1716"/>
|
<Caret Line="1791" Column="29" TopLine="1769"/>
|
||||||
</Position17>
|
</Position17>
|
||||||
<Position18>
|
<Position18>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1748" Column="38" TopLine="1716"/>
|
<Caret Line="1793" Column="29" TopLine="1769"/>
|
||||||
</Position18>
|
</Position18>
|
||||||
<Position19>
|
<Position19>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1750" Column="44" TopLine="1733"/>
|
<Caret Line="1794" Column="44" TopLine="1769"/>
|
||||||
</Position19>
|
</Position19>
|
||||||
<Position20>
|
<Position20>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1752" Column="24" TopLine="1733"/>
|
<Caret Line="1795" Column="52" TopLine="1769"/>
|
||||||
</Position20>
|
</Position20>
|
||||||
<Position21>
|
<Position21>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1764" Column="26" TopLine="1733"/>
|
<Caret Line="1796" Column="37" TopLine="1769"/>
|
||||||
</Position21>
|
</Position21>
|
||||||
<Position22>
|
<Position22>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||||
<Caret Line="1768" Column="42" TopLine="1751"/>
|
<Caret Line="199" Column="20" TopLine="173"/>
|
||||||
</Position22>
|
</Position22>
|
||||||
<Position23>
|
<Position23>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="debugimage.pas"/>
|
||||||
<Caret Line="1786" Column="65" TopLine="1769"/>
|
<Caret Line="17" Column="66" TopLine="1"/>
|
||||||
</Position23>
|
</Position23>
|
||||||
<Position24>
|
|
||||||
<Filename Value="testunit.pas"/>
|
|
||||||
<Caret Line="1789" Column="31" TopLine="1769"/>
|
|
||||||
</Position24>
|
|
||||||
<Position25>
|
|
||||||
<Filename Value="testunit.pas"/>
|
|
||||||
<Caret Line="1791" Column="29" TopLine="1769"/>
|
|
||||||
</Position25>
|
|
||||||
<Position26>
|
|
||||||
<Filename Value="testunit.pas"/>
|
|
||||||
<Caret Line="1793" Column="29" TopLine="1769"/>
|
|
||||||
</Position26>
|
|
||||||
<Position27>
|
|
||||||
<Filename Value="testunit.pas"/>
|
|
||||||
<Caret Line="1794" Column="44" TopLine="1769"/>
|
|
||||||
</Position27>
|
|
||||||
<Position28>
|
|
||||||
<Filename Value="testunit.pas"/>
|
|
||||||
<Caret Line="1795" Column="52" TopLine="1769"/>
|
|
||||||
</Position28>
|
|
||||||
<Position29>
|
|
||||||
<Filename Value="testunit.pas"/>
|
|
||||||
<Caret Line="1796" Column="37" TopLine="1769"/>
|
|
||||||
</Position29>
|
|
||||||
</JumpHistory>
|
</JumpHistory>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
@ -2181,10 +2156,9 @@
|
|||||||
<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="$(ProjPath)../../build/$(TargetOS)/"/>
|
||||||
<LCLWidgetType Value="win32"/>
|
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<CodeGeneration>
|
<CodeGeneration>
|
||||||
<TargetOS Value="Win32"/>
|
<TargetOS Value="Linux"/>
|
||||||
<Optimizations>
|
<Optimizations>
|
||||||
<VariablesInRegisters Value="True"/>
|
<VariablesInRegisters Value="True"/>
|
||||||
<OptimizationLevel Value="2"/>
|
<OptimizationLevel Value="2"/>
|
||||||
|
|||||||
@ -168,7 +168,6 @@ 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');
|
||||||
|
|||||||
@ -129,7 +129,6 @@ 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.
|
||||||
|
|||||||
@ -32,7 +32,6 @@ uses
|
|||||||
ctypes,
|
ctypes,
|
||||||
{$IFDEF MSWINDOWS} os_windows, {$ENDIF}
|
{$IFDEF MSWINDOWS} os_windows, {$ENDIF}
|
||||||
{$IFDEF LINUX} os_linux, {$ENDIF}
|
{$IFDEF LINUX} os_linux, {$ENDIF}
|
||||||
windowutil,
|
|
||||||
controls,
|
controls,
|
||||||
graphics,
|
graphics,
|
||||||
forms,
|
forms,
|
||||||
|
|||||||
@ -110,13 +110,49 @@ type
|
|||||||
destructor Destroy;override;
|
destructor Destroy;override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Windowutil,paszlib,DCPbase64,math,
|
paszlib,DCPbase64,math,
|
||||||
colour_conv,IOManager,mufasatypesutil,tpa;
|
colour_conv,IOManager,mufasatypesutil,tpa;
|
||||||
|
|
||||||
|
// Needs more fixing. We need to either copy the memory ourself, or somehow
|
||||||
|
// find a TRawImage feature to skip X bytes after X bytes read. (Most likely a
|
||||||
|
// feature)
|
||||||
|
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
|
||||||
|
Begin
|
||||||
|
RawImage.Init; { Calls raw.Description.Init as well }
|
||||||
|
|
||||||
|
RawImage.Description.PaletteColorCount:=0;
|
||||||
|
RawImage.Description.MaskBitsPerPixel:=0;
|
||||||
|
RawImage.Description.Width := Size.X;
|
||||||
|
RawImage.Description.Height:= Size.Y;
|
||||||
|
|
||||||
|
RawImage.Description.Format := ricfRGBA;
|
||||||
|
RawImage.Description.ByteOrder := riboLSBFirst;
|
||||||
|
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
|
||||||
|
RawImage.Description.Depth:=24;
|
||||||
|
RawImage.Description.BitsPerPixel:=32;
|
||||||
|
RawImage.Description.LineOrder:=riloTopToBottom;
|
||||||
|
RawImage.Description.LineEnd := rileDWordBoundary;
|
||||||
|
|
||||||
|
RawImage.Description.RedPrec := 8;
|
||||||
|
RawImage.Description.GreenPrec:= 8;
|
||||||
|
RawImage.Description.BluePrec:= 8;
|
||||||
|
RawImage.Description.AlphaPrec:=0;
|
||||||
|
|
||||||
|
|
||||||
|
RawImage.Description.RedShift:=16;
|
||||||
|
RawImage.Description.GreenShift:=8;
|
||||||
|
RawImage.Description.BlueShift:=0;
|
||||||
|
|
||||||
|
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
|
||||||
|
* (RawImage.Description.bitsperpixel shr 3);
|
||||||
|
RawImage.Data := PByte(Ptr);
|
||||||
|
End;
|
||||||
|
|
||||||
function Min(a,b:integer) : integer;
|
function Min(a,b:integer) : integer;
|
||||||
begin
|
begin
|
||||||
if a < b then
|
if a < b then
|
||||||
|
|||||||
@ -1,464 +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 Class for the Mufasa Macro Library
|
|
||||||
}
|
|
||||||
|
|
||||||
unit Input;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils,
|
|
||||||
mufasatypes, // for common mufasa types
|
|
||||||
windowutil, // for mufasa window utils
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
ctypes,x, xlib,xtest,keysym,// for X* stuff
|
|
||||||
// do non silent keys/mouse with XTest / TKeyInput.
|
|
||||||
{Later on we should use xdotool, as it allows silent input}
|
|
||||||
{$ENDIF}
|
|
||||||
MMLKeyInput, lclintf,math,window;
|
|
||||||
|
|
||||||
type
|
|
||||||
TMInput = class(TObject)
|
|
||||||
constructor Create(Window: TMWindow);
|
|
||||||
destructor Destroy; override;
|
|
||||||
|
|
||||||
procedure GetMousePos(out 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 KeyUp(key: Word);
|
|
||||||
procedure KeyDown(key: Word);
|
|
||||||
procedure PressKey(key: Word);
|
|
||||||
procedure SendText(text: string);
|
|
||||||
function isKeyDown(key: Word): Boolean;
|
|
||||||
|
|
||||||
// Not used yet.
|
|
||||||
procedure SetSilent(_Silent: Boolean);
|
|
||||||
|
|
||||||
{
|
|
||||||
Possibly change to GetMouseButtonStates? Then people can get the
|
|
||||||
states bitwise. Like X and WinAPI.
|
|
||||||
}
|
|
||||||
function IsMouseButtonDown(mType: TClickType): Boolean;
|
|
||||||
|
|
||||||
public
|
|
||||||
Window: TMWindow;
|
|
||||||
private
|
|
||||||
// Not used yet.
|
|
||||||
Silent: Boolean;
|
|
||||||
KeyInput: TMMLKeyInput;
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
function GetKeyCode(key : char) : byte;
|
|
||||||
implementation
|
|
||||||
|
|
||||||
uses
|
|
||||||
{$IFDEF MSWINDOWS}windows, {$ENDIF}interfacebase,lcltype;
|
|
||||||
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
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;
|
|
||||||
|
|
||||||
{Mouse}
|
|
||||||
function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT; stdcall; external user32 name 'SendInput';
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
constructor TMInput.Create(Window: TMWindow);
|
|
||||||
begin
|
|
||||||
inherited Create;
|
|
||||||
Self.Window := Window;
|
|
||||||
Self.KeyInput := TMMLKeyInput.Create;
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
destructor TMInput.Destroy;
|
|
||||||
begin
|
|
||||||
|
|
||||||
Self.KeyInput.Free;
|
|
||||||
inherited;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.KeyUp(key: Word);
|
|
||||||
|
|
||||||
begin
|
|
||||||
Self.KeyInput.Up(Key);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.KeyDown(key: Word);
|
|
||||||
|
|
||||||
begin
|
|
||||||
Self.KeyInput.Down(Key);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.PressKey(key: Word);
|
|
||||||
begin
|
|
||||||
Self.KeyDown(key);
|
|
||||||
Self.KeyUp(key);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ No using VkKeyScan }
|
|
||||||
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;
|
|
||||||
|
|
||||||
function GetKeyCode(Key: Char): Byte;
|
|
||||||
begin
|
|
||||||
{$ifdef MSWINDOWS}
|
|
||||||
result := VkKeyScan(Key)and $FF;
|
|
||||||
{$else}
|
|
||||||
result := GetSimpleKeyCode(Key);
|
|
||||||
{$endif}
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.SendText(text: string);
|
|
||||||
var
|
|
||||||
i: integer;
|
|
||||||
HoldShift : boolean;
|
|
||||||
|
|
||||||
begin
|
|
||||||
HoldShift := false;
|
|
||||||
for i := 1 to length(text) do
|
|
||||||
begin
|
|
||||||
if((text[i] >= 'A') and (text[i] <= 'Z')) then
|
|
||||||
begin
|
|
||||||
Self.KeyDown(VK_SHIFT);
|
|
||||||
HoldShift:= True;
|
|
||||||
Text[i] := lowerCase(Text[i]);
|
|
||||||
end else
|
|
||||||
if HoldShift then
|
|
||||||
begin
|
|
||||||
HoldShift:= false;
|
|
||||||
Self.KeyUp(VK_SHIFT);
|
|
||||||
end;
|
|
||||||
Self.PressKey( GetSimpleKeyCode(Text[i]));
|
|
||||||
end;
|
|
||||||
if HoldShift then
|
|
||||||
Self.KeyUp(VK_SHIFT);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TMInput.isKeyDown(key: Word): Boolean;
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
{var
|
|
||||||
key_states: chararr32;
|
|
||||||
i, j: integer;
|
|
||||||
_key: TKeySym;
|
|
||||||
_code: TKeyCode;
|
|
||||||
wat: integer; }
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
raise Exception.CreateFmt('IsKeyDown isn''t implemented yet on Windows', []);
|
|
||||||
|
|
||||||
{$ELSE}
|
|
||||||
raise Exception.CreateFmt('IsKeyDown isn''t implemented yet on Linux', []);
|
|
||||||
{XQueryKeymap(TClient(Client).MWindow.XDisplay, key_states);
|
|
||||||
_key := VirtualKeyToXKeySym(key);
|
|
||||||
_code := XKeysymToKeycode(TClient(Client).MWindow.XDisplay, _key);
|
|
||||||
|
|
||||||
for i := 0 to 31 do
|
|
||||||
for j := 7 to 0 do
|
|
||||||
begin
|
|
||||||
wat := Byte(key_states[i]) and (1 shl (j));
|
|
||||||
if wat > 0 then
|
|
||||||
begin
|
|
||||||
writeln(inttostr((i * 8) + j) + ': ' + inttostr(Byte(key_states[i]) and (1 shl j)));
|
|
||||||
writeln(inttostr((i * 8) + j) + ': ' + inttostr(Byte(key_states[i]) and (1 shl (8-j))));
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
writeln(Format('key: %d, _key: %d, _code: %d', [key, _key, _code]));
|
|
||||||
writeln('Wat: ' + inttostr((Byte(key_states[floor(_code / 8)]) and 1 shl (_code mod 8))));
|
|
||||||
result := (Byte(key_states[floor(_code / 8)]) and 1 shl (_code mod 8)) > 0; }
|
|
||||||
{XQueryKeymap -> Print all values ! }
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.GetMousePos(out X, Y: Integer);
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
b:integer;
|
|
||||||
root, child: twindow;
|
|
||||||
xmask: Cardinal;
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
var
|
|
||||||
MousePoint : TPoint;
|
|
||||||
Rect : TRect;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
Windows.GetCursorPos(MousePoint);
|
|
||||||
GetWindowRect(Window.TargetHandle,Rect);
|
|
||||||
x := MousePoint.x - Rect.Left;
|
|
||||||
y := MousePoint.y - Rect.Top;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
XQueryPointer(Window.XDisplay,Window.CurWindow,@root,@child,@b,@b,@x,@y,@xmask);
|
|
||||||
XSetErrorHandler(Old_Handler);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.SetMousePos(X, Y: Integer);
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
var
|
|
||||||
rect : TRect;
|
|
||||||
{$ENDIF}
|
|
||||||
w,h: integer;
|
|
||||||
begin
|
|
||||||
|
|
||||||
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
GetWindowRect(Window.TargetHandle, 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);
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
// This may be a bit too much overhead.
|
|
||||||
Window.GetDimensions(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', [x, y]);
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
XWarpPointer(Window.XDisplay, 0, Window.CurWindow, 0, 0, 0, 0, X, Y);
|
|
||||||
XFlush(Window.XDisplay);
|
|
||||||
XSetErrorHandler(Old_Handler);
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress);
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
ButtonP: cuint;
|
|
||||||
_isPress: cbool;
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
var
|
|
||||||
Input : TInput;
|
|
||||||
Rect : TRect;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
GetWindowRect(Window.TargetHandle, Rect);
|
|
||||||
Input.Itype:= INPUT_MOUSE;
|
|
||||||
FillChar(Input,Sizeof(Input),0);
|
|
||||||
Input.mi.dx:= x + Rect.left;
|
|
||||||
Input.mi.dy:= y + Rect.Top;
|
|
||||||
if mPress = mouse_Down then
|
|
||||||
begin
|
|
||||||
case mClick 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;
|
|
||||||
end else
|
|
||||||
case mClick 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));
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
|
|
||||||
if mPress = mouse_Down then
|
|
||||||
_isPress := cbool(1)
|
|
||||||
else
|
|
||||||
_isPress := cbool(0);
|
|
||||||
|
|
||||||
case mClick of
|
|
||||||
mouse_Left: ButtonP := Button1;
|
|
||||||
mouse_Middle:ButtonP := Button2;
|
|
||||||
mouse_Right: ButtonP := Button3;
|
|
||||||
end;
|
|
||||||
|
|
||||||
XTestFakeButtonEvent(Window.XDisplay, ButtonP,
|
|
||||||
_isPress, CurrentTime);
|
|
||||||
|
|
||||||
XSetErrorHandler(Old_Handler);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.MouseButtonActionSilent(x,y : integer; mClick: TClickType; mPress: TMousePress);
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
event : TXEvent;
|
|
||||||
Garbage : QWord;
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
var
|
|
||||||
Input : TInput;
|
|
||||||
Rect : TRect;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
writeln('Not implemented');
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
|
|
||||||
FillChar(event,sizeof(TXevent),0);
|
|
||||||
|
|
||||||
if mPress = mouse_Down then
|
|
||||||
Event._type:= ButtonPress
|
|
||||||
else
|
|
||||||
Event._type:= ButtonRelease;
|
|
||||||
|
|
||||||
case mClick of
|
|
||||||
mouse_Left: Event.xbutton.button:= Button1;
|
|
||||||
mouse_Middle: Event.xbutton.button:= Button2;
|
|
||||||
mouse_Right: Event.xbutton.button:= Button3;
|
|
||||||
end;
|
|
||||||
|
|
||||||
event.xbutton.send_event := TBool(1); // true if this came from a "send event"
|
|
||||||
event.xbutton.same_screen:= TBool(1);
|
|
||||||
event.xbutton.subwindow:= 0; // this can't be right.
|
|
||||||
event.xbutton.root := Window.DesktopWindow;
|
|
||||||
event.xbutton.window := Window.CurWindow;
|
|
||||||
event.xbutton.x_root:= x;
|
|
||||||
event.xbutton.y_root:= y;
|
|
||||||
event.xbutton.x := x;
|
|
||||||
event.xbutton.y := y;
|
|
||||||
event.xbutton.state:= 0;
|
|
||||||
if(XSendEvent(Window.XDisplay, PointerWindow, True, $fff, @event) = 0) then
|
|
||||||
Writeln('Errorrrr :-(');
|
|
||||||
XFlush(Window.XDisplay);
|
|
||||||
|
|
||||||
XSetErrorHandler(Old_Handler);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.ClickMouse(X, Y: Integer; mClick: TClickType);
|
|
||||||
|
|
||||||
begin
|
|
||||||
Self.SetMousePos(x,y);
|
|
||||||
Self.MouseButtonAction(X, Y, mClick, mouse_Down);
|
|
||||||
Self.MouseButtonAction(X, Y, mClick, mouse_Up);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMInput.SetSilent(_Silent: Boolean);
|
|
||||||
begin
|
|
||||||
raise exception.CreateFmt('Input - SetSilent / Silent is not implemented',[]);
|
|
||||||
Self.Silent := _Silent;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TMInput.IsMouseButtonDown(mType: TClickType): Boolean;
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
rootx, rooty, x, y:integer;
|
|
||||||
root, child: twindow;
|
|
||||||
xmask: Cardinal;
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
case mType of
|
|
||||||
Mouse_Left: Result := (GetAsyncKeyState(VK_LBUTTON) <> 0);
|
|
||||||
Mouse_Middle: Result := (GetAsyncKeyState(VK_MBUTTON) <> 0);
|
|
||||||
mouse_Right: Result := (GetAsyncKeyState(VK_RBUTTON) <> 0);
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
XQueryPointer(Window.XDisplay,Window.CurWindow,@root,@child,@rootx,@rooty,@x,@y,@xmask);
|
|
||||||
|
|
||||||
case mType of
|
|
||||||
mouse_Left: Result := (xmask and Button1Mask) <> 0;
|
|
||||||
mouse_Middle: Result := (xmask and Button2Mask) <> 0;
|
|
||||||
mouse_Right: Result := (xmask and Button3Mask) <> 0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
XSetErrorHandler(Old_Handler);
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,3 +1,26 @@
|
|||||||
|
{
|
||||||
|
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;
|
unit IOManager;
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|||||||
@ -1,62 +0,0 @@
|
|||||||
unit MMLKeyInput;
|
|
||||||
|
|
||||||
{
|
|
||||||
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.
|
|
||||||
|
|
||||||
MMLKeyInput class for Keyboard input in MML.
|
|
||||||
}
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, {$IFDEF MSWINDOWS}WinKeyInput{$ELSE}XKeyInput{$ENDIF};
|
|
||||||
|
|
||||||
type
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
TMMLKeyInput = class(TWinKeyInput)
|
|
||||||
{$ELSE}
|
|
||||||
TMMLKeyInput = class(TXKeyInput)
|
|
||||||
{$ENDIF}
|
|
||||||
public
|
|
||||||
{ Override these two methods,
|
|
||||||
as the original class calls ProcessMessages;
|
|
||||||
}
|
|
||||||
procedure Down(Key: Word);
|
|
||||||
procedure Up(Key: Word);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
implementation
|
|
||||||
uses LCLType;
|
|
||||||
|
|
||||||
procedure TMMLKeyInput.Down(Key: Word);
|
|
||||||
begin
|
|
||||||
DoDown(Key);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMMLKeyInput.Up(Key: Word);
|
|
||||||
begin
|
|
||||||
DoUp(Key);
|
|
||||||
end;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,3 +1,26 @@
|
|||||||
|
{
|
||||||
|
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;
|
unit os_linux;
|
||||||
|
|
||||||
interface
|
interface
|
||||||
@ -56,10 +79,25 @@ interface
|
|||||||
desktop: x.TWindow;
|
desktop: x.TWindow;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses windowutil, GraphType, interfacebase, lcltype;
|
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
|
//***implementation*** TKeyInput
|
||||||
|
|
||||||
|
|||||||
@ -1,3 +1,26 @@
|
|||||||
|
{
|
||||||
|
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;
|
unit os_windows;
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|||||||
@ -1,737 +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.
|
|
||||||
|
|
||||||
Window class for the Mufasa Macro Library
|
|
||||||
}
|
|
||||||
|
|
||||||
unit Window;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, mufasatypes,
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
windows, // For windows API
|
|
||||||
{$ENDIF}
|
|
||||||
graphics,
|
|
||||||
LCLType,
|
|
||||||
bitmaps,
|
|
||||||
LCLIntf // for ReleaseDC and such
|
|
||||||
|
|
||||||
{$IFDEF LINUX}, xlib, x, xutil{$ENDIF};
|
|
||||||
|
|
||||||
type
|
|
||||||
|
|
||||||
{
|
|
||||||
TMWindow Class handles all interaction with the Operating System Display
|
|
||||||
Getting Window ID's, Window Bitmap Data, Window Size.
|
|
||||||
|
|
||||||
It also abstracts data allocation from the user. Downside is there can't
|
|
||||||
be more than one Data in memory.
|
|
||||||
|
|
||||||
EG: One uses ReturnData, but must Free the data with FreeReturnData;
|
|
||||||
If one calls ReturnData, one must first free the ReturnData, before
|
|
||||||
calling ReturnData again.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
TMWindow = class(TObject)
|
|
||||||
function GetColor(x,y : integer) : TColor;
|
|
||||||
function ReturnData(xs, ys, width, height: Integer): TRetData;
|
|
||||||
procedure FreeReturnData;
|
|
||||||
procedure GetDimensions(out W, H: Integer);
|
|
||||||
function GetDimensionBox(out Box : TBox) : boolean;
|
|
||||||
procedure ActivateClient;
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
function SetTarget(XWindow: x.TWindow): integer; overload;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
function UpdateDrawBitmap:boolean;
|
|
||||||
{$ENDIF}
|
|
||||||
function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
|
|
||||||
function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
|
||||||
function SetTarget(Bitmap : TMufasaBitmap) : integer;overload;
|
|
||||||
function TargetValid: Boolean;
|
|
||||||
|
|
||||||
procedure SetWindow(Window: TMWindow);
|
|
||||||
procedure SetDesktop;
|
|
||||||
|
|
||||||
procedure OnTargetBitmapDestroy( Bitmap : TMufasaBitmap);
|
|
||||||
{
|
|
||||||
Freeze Client Feature.
|
|
||||||
This will force the MWindow unit to Store the current Client's
|
|
||||||
data in whatever internal structure it will use, and returndata /
|
|
||||||
copyclienttobitmap will not renew this data until Unfreeze() is
|
|
||||||
called.
|
|
||||||
}
|
|
||||||
|
|
||||||
function Freeze: boolean;
|
|
||||||
function Unfreeze: boolean;
|
|
||||||
|
|
||||||
constructor Create;
|
|
||||||
destructor Destroy; override;
|
|
||||||
|
|
||||||
private
|
|
||||||
FreezeState: Boolean;
|
|
||||||
FrozenData : PRGB32;
|
|
||||||
FrozenSize : TPoint;
|
|
||||||
TargetBitmap : TMufasaBitmap;
|
|
||||||
{:Called before setting the NewTarget, deletes stuff related to OldTarget and sets the new targetmode}
|
|
||||||
procedure OnSetTarget(NewTarget,OldTarget : TTargetWindowMode);
|
|
||||||
public
|
|
||||||
// Target Window Mode.
|
|
||||||
TargetMode: TTargetWindowMode;
|
|
||||||
|
|
||||||
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
//Target handle; HWND
|
|
||||||
TargetHandle : Hwnd;
|
|
||||||
DrawBmpDataPtr : PRGB32;
|
|
||||||
DesktopHWND : Hwnd;
|
|
||||||
DesktopDC : HDC;
|
|
||||||
//Works on linux as well, test it out
|
|
||||||
TargetDC : HDC;
|
|
||||||
DrawBitmap : TBitmap;
|
|
||||||
DrawBmpW,DrawBmpH : integer;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
// X Display
|
|
||||||
XDisplay: PDisplay;
|
|
||||||
|
|
||||||
// Connection Number
|
|
||||||
XConnectionNumber: Integer;
|
|
||||||
|
|
||||||
// X Window
|
|
||||||
CurWindow: x.TWindow;
|
|
||||||
|
|
||||||
// Desktop Window
|
|
||||||
DesktopWindow: x.TWindow;
|
|
||||||
|
|
||||||
// X Screen
|
|
||||||
XScreen: PScreen;
|
|
||||||
|
|
||||||
// X Screen Number
|
|
||||||
XScreenNum: Integer;
|
|
||||||
|
|
||||||
// The X Image pointer.
|
|
||||||
XWindowImage: PXImage;
|
|
||||||
|
|
||||||
// XImageFreed should be True if there is currently no
|
|
||||||
// XImage loaded. If one is loaded, XImageFreed is true.
|
|
||||||
|
|
||||||
// If ReturnData is called while XImageFreed is false,
|
|
||||||
// we throw an exception.
|
|
||||||
// Same for FreeReturnData with XImageFreed true.
|
|
||||||
XImageFreed: Boolean;
|
|
||||||
|
|
||||||
{$ELSE}
|
|
||||||
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
ArrayPtr: PRGB32;
|
|
||||||
ArraySize: TPoint;
|
|
||||||
|
|
||||||
property Frozen: boolean read FreezeState;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
uses windowutil, GraphType;
|
|
||||||
|
|
||||||
constructor TMWindow.Create;
|
|
||||||
begin
|
|
||||||
inherited Create;
|
|
||||||
|
|
||||||
Self.FrozenData:= nil;
|
|
||||||
Self.FrozenSize := Classes.Point(-1,-1);
|
|
||||||
Self.FreezeState := False;
|
|
||||||
|
|
||||||
Self.ArrayPtr := nil;
|
|
||||||
Self.ArraySize := Classes.Point(-1, -1);
|
|
||||||
|
|
||||||
Self.TargetBitmap := nil;
|
|
||||||
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
Self.DrawBitmap := TBitmap.Create;
|
|
||||||
Self.DrawBitmap.PixelFormat:= pf32bit;
|
|
||||||
Self.TargetMode:= w_Window;
|
|
||||||
Self.TargetHandle:= 0;
|
|
||||||
Self.TargetDC := 0;
|
|
||||||
Self.DesktopHWND:= GetDesktopWindow;
|
|
||||||
Self.DesktopDC:= GetDC(0);
|
|
||||||
Self.SetDesktop;
|
|
||||||
Self.UpdateDrawBitmap;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Self.XImageFreed:=True;
|
|
||||||
Self.TargetMode := w_XWindow;
|
|
||||||
|
|
||||||
Self.XDisplay := XOpenDisplay(nil);
|
|
||||||
if Self.XDisplay = nil then
|
|
||||||
begin
|
|
||||||
// throw Exception
|
|
||||||
end;
|
|
||||||
Self.XConnectionNumber:= ConnectionNumber(Self.XDisplay);
|
|
||||||
Self.XScreen := XDefaultScreenOfDisplay(Self.XDisplay);
|
|
||||||
Self.XScreenNum:= DefaultScreen(Self.XDisplay);
|
|
||||||
|
|
||||||
// The Root Window is the Desktop. :-)
|
|
||||||
Self.DesktopWindow:= RootWindow(Self.XDisplay, Self.XScreenNum);
|
|
||||||
Self.CurWindow:= Self.DesktopWindow;
|
|
||||||
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
destructor TMWindow.Destroy;
|
|
||||||
begin
|
|
||||||
if FreezeState then
|
|
||||||
if FrozenData <> nil then
|
|
||||||
FreeMem(FrozenData);
|
|
||||||
|
|
||||||
FreeReturnData; // checks if it is freed or not. if it is not freed, it frees.
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
XCloseDisplay(Self.XDisplay);
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
if TargetMode = w_Window then
|
|
||||||
ReleaseDC(TargetHandle,TargetDC);
|
|
||||||
DrawBitmap.Free;
|
|
||||||
{$ENDIF}
|
|
||||||
inherited;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure TMWindow.OnSetTarget(NewTarget,OldTarget : TTargetWindowMode);
|
|
||||||
begin
|
|
||||||
case OldTarget of
|
|
||||||
w_Window: begin
|
|
||||||
{$IFDEF WINDOWS}
|
|
||||||
if not Self.TargetDC= Self.DesktopDC then
|
|
||||||
ReleaseDC(Self.TargetHandle,Self.TargetDC);
|
|
||||||
{$ELSE}
|
|
||||||
raise Exception.Create('Handle/DC not supported on Linux');
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
w_XWindow: Self.FreeReturnData;
|
|
||||||
end;
|
|
||||||
//Set them to zero, just in case ;-).
|
|
||||||
if NewTarget <> w_BMP then
|
|
||||||
Self.TargetBitmap := nil;
|
|
||||||
if NewTarget <> w_ArrayPtr then
|
|
||||||
self.ArrayPtr := nil;
|
|
||||||
Self.TargetMode:= NewTarget;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMWindow.SetWindow(Window: TMWindow);
|
|
||||||
begin
|
|
||||||
case Window.TargetMode of
|
|
||||||
w_BMP :
|
|
||||||
Self.SetTarget(Window.TargetBitmap);
|
|
||||||
w_Window, w_HDC:
|
|
||||||
{$IFDEF WINDOWS}
|
|
||||||
Self.SetTarget(Window.TargetHandle, Window.TargetMode);
|
|
||||||
{$ELSE}
|
|
||||||
writeln('TMWindow.SetWindow - Handle not supported');
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
// I don't think array can ever be set at this point.
|
|
||||||
// Let's just add it anyway. ;)
|
|
||||||
w_ArrayPtr:
|
|
||||||
Self.SetTarget(Window.ArrayPtr, Window.ArraySize);
|
|
||||||
|
|
||||||
w_XWindow:
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Self.SetTarget(Window.CurWindow);
|
|
||||||
{$ELSE}
|
|
||||||
writeln('TMWindow.SetWindow - XImage not supported');
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMWindow.SetDesktop;
|
|
||||||
begin
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Self.SetTarget(Self.DesktopWindow);
|
|
||||||
{$ELSE}
|
|
||||||
OnSetTarget(w_window, Self.TargetMode);
|
|
||||||
Self.TargetDC:= DesktopDC;
|
|
||||||
Self.TargetHandle:= DesktopHWND;
|
|
||||||
UpdateDrawBitmap;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function TMWindow.TargetValid: Boolean;
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
old_handler: TXErrorHandler;
|
|
||||||
Attrib: TXWindowAttributes;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
case Self.TargetMode of
|
|
||||||
w_BMP : result := TargetBitmap <> nil;
|
|
||||||
w_Window :
|
|
||||||
begin
|
|
||||||
{$IFDEF WINDOWS}
|
|
||||||
result := IsWindow(self.TargetHandle);
|
|
||||||
{$ELSE}
|
|
||||||
Raise Exception.Create('TargetValid: Linux and w_Window');
|
|
||||||
result := False;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
w_ArrayPtr : result := ArrayPtr <> nil;
|
|
||||||
w_HDC :
|
|
||||||
begin
|
|
||||||
{$IFDEF WINDOWS}
|
|
||||||
result := Self.TargetDC <> 0;
|
|
||||||
{$ELSE}
|
|
||||||
Raise Exception.Create('TargetValid: Linux and w_HDC');
|
|
||||||
result := False;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
w_XWindow : begin
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
old_handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
{ There must be a better way to do this, at least with less overhead. }
|
|
||||||
if XGetWindowAttributes(Self.XDisplay, Self.CurWindow, @Attrib) = 0 then
|
|
||||||
result := false
|
|
||||||
else
|
|
||||||
result := true;
|
|
||||||
XSetErrorHandler(old_handler);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMWindow.OnTargetBitmapDestroy(Bitmap: TMufasaBitmap);
|
|
||||||
begin
|
|
||||||
Self.SetDesktop;
|
|
||||||
writeln('Our current bitmap is being freed! Defaulting to Desktop.');
|
|
||||||
// raise Exception.CreateFmt('Our targetbitmap has been destroyed, what now?',[]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TMWindow.GetColor(x, y: integer): TColor;
|
|
||||||
begin
|
|
||||||
{$IFDEF WINDOWS}
|
|
||||||
if Self.TargetMode = w_Window then
|
|
||||||
Result := GetPixel(Self.TargetDC,x,y)
|
|
||||||
else
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
with ReturnData(x,y,1,1) do
|
|
||||||
Result := RGBToColor(Ptr[0].r,Ptr[0].g,Ptr[0].b);
|
|
||||||
FreeReturnData;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TMWindow.ReturnData(xs, ys, width, height: Integer): TRetData;
|
|
||||||
var
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
TmpData: PRGB32;
|
|
||||||
w,h : integer;
|
|
||||||
begin
|
|
||||||
Self.GetDimensions(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 Self.Frozen then
|
|
||||||
begin;
|
|
||||||
TmpData := Self.FrozenData;
|
|
||||||
Result.RowLen:= Self.FrozenSize.x;
|
|
||||||
Result.IncPtrWith:= Result.RowLen - width;
|
|
||||||
Inc(TmpData, ys * Result.RowLen + xs);
|
|
||||||
Result.Ptr:= tmpData;
|
|
||||||
end else
|
|
||||||
case Self.TargetMode of
|
|
||||||
w_BMP :
|
|
||||||
begin;
|
|
||||||
// Copy the pointer as we will perform operations on it.
|
|
||||||
TmpData := TargetBitmap.FData;
|
|
||||||
|
|
||||||
// Increase the pointer to the specified start of the data.
|
|
||||||
Result.RowLen:= TargetBitmap.Width;
|
|
||||||
Result.IncPtrWith:= Result.RowLen - width;
|
|
||||||
Inc(TmpData, ys * Result.RowLen + xs);
|
|
||||||
Result.Ptr := TmpData;
|
|
||||||
end;
|
|
||||||
w_Window:
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
BitBlt(Self.DrawBitmap.Canvas.Handle,0,0, width, height, Self.TargetDC, xs,ys, SRCCOPY);
|
|
||||||
Result.Ptr:= Self.DrawBmpDataPtr;
|
|
||||||
Result.IncPtrWith:= DrawBmpW - Width;
|
|
||||||
Result.RowLen:= DrawBmpW;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
w_XWindow:
|
|
||||||
begin
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
if not Self.XImageFreed then
|
|
||||||
Raise Exception.CreateFmt('ReturnData was called again without freeing'+
|
|
||||||
' the previously used data. Do not forget to'+
|
|
||||||
' call FreeReturnData', []);
|
|
||||||
{ Should be this. }
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
|
|
||||||
Self.XWindowImage := XGetImage(Self.XDisplay, Self.curWindow, xs, ys, width, height, AllPlanes, ZPixmap);
|
|
||||||
if Self.XWindowImage = 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;
|
|
||||||
//WriteLn(IntToStr(Self.XWindowImage^.width) + ', ' + IntToStr(Self.XWindowImage^.height));
|
|
||||||
Result.Ptr := PRGB32(Self.XWindowImage^.data);
|
|
||||||
Result.IncPtrWith := 0;
|
|
||||||
Result.RowLen := width;
|
|
||||||
Self.XImageFreed:=False;
|
|
||||||
|
|
||||||
XSetErrorHandler(Old_Handler);
|
|
||||||
{$ELSE}
|
|
||||||
raise Exception.createFMT('ReturnData: You cannot use ' +
|
|
||||||
'the XImage mode on Windows.', []);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
w_ArrayPtr:
|
|
||||||
begin
|
|
||||||
// Copy the pointer as we will perform operations on it.
|
|
||||||
TmpData := Self.ArrayPtr;
|
|
||||||
|
|
||||||
// Increase the pointer to the specified start of the data.
|
|
||||||
Result.RowLen:= Self.ArraySize.x;
|
|
||||||
Result.IncPtrWith:= Result.RowLen - width;
|
|
||||||
Inc(TmpData, ys * Result.RowLen + xs);
|
|
||||||
Result.Ptr := TmpData;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMWindow.FreeReturnData;
|
|
||||||
begin
|
|
||||||
if (Self.TargetMode <> w_XWindow) or FreezeState then
|
|
||||||
Exit;
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
if not Self.XImageFreed then
|
|
||||||
begin
|
|
||||||
Self.XImageFreed:=True;
|
|
||||||
if(Self.XWindowImage <> nil) then
|
|
||||||
begin
|
|
||||||
XDestroyImage(Self.XWindowImage);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
{
|
|
||||||
This will draw the ENTIRE client to a bitmap.
|
|
||||||
And ReturnData / CopyClientToBitmap will always use this bitmap.
|
|
||||||
They must NEVER update, unless Unfreeze is called.
|
|
||||||
|
|
||||||
I am not entirely sure how to do this, yet.
|
|
||||||
Best option for now seems to copy the entire data to a PRGB32,
|
|
||||||
and use it like the ArrPtr mode.
|
|
||||||
|
|
||||||
I currently added "Frozen", "FreezeState", "Freeze" and "Unfreeze".
|
|
||||||
We will have to either "abuse" the current system, and set the client to
|
|
||||||
PtrArray mode, or edit in some extra variables.
|
|
||||||
(We will still need extra variables to remember the old mode,
|
|
||||||
to which we will switch back with Unfreeze.)
|
|
||||||
|
|
||||||
Several ways to do it, what's the best way?
|
|
||||||
|
|
||||||
Also, should a box be passed to Freeze, or should we just copy the entire
|
|
||||||
client?
|
|
||||||
}
|
|
||||||
function TMWindow.Freeze: Boolean;
|
|
||||||
var
|
|
||||||
w,h : integer;
|
|
||||||
PtrReturn : TRetData;
|
|
||||||
begin
|
|
||||||
if Self.FreezeState then
|
|
||||||
raise Exception.CreateFMT('TMWindow.Freeze: The window is already frozen.',[]);
|
|
||||||
Result := true;
|
|
||||||
Self.GetDimensions(w,h);
|
|
||||||
Self.FrozenSize := Classes.Point(w,h);
|
|
||||||
PtrReturn := Self.ReturnData(0,0,w,h);
|
|
||||||
GetMem(Self.FrozenData, w * h * sizeof(TRGB32));
|
|
||||||
Move(PtrReturn.Ptr[0], FrozenData[0], w*h*sizeof(TRGB32));
|
|
||||||
Self.FreeReturnData;
|
|
||||||
Self.FreezeState:=True;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TMWindow.Unfreeze: Boolean;
|
|
||||||
begin
|
|
||||||
if Self.FreezeState = false then
|
|
||||||
raise Exception.CreateFMT('TMWindow.Unfreeze: The window is not frozen.',[]);
|
|
||||||
FreeMem(Self.FrozenData);
|
|
||||||
Self.FrozenData := nil;
|
|
||||||
Self.FreezeState:=False;
|
|
||||||
Result := True;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Set's input focus on Linux, does not mean the window will look `active', but
|
|
||||||
// it surely is. Try typing something after ActivateClient.
|
|
||||||
procedure TMWindow.ActivateClient;
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
if TargetMode = w_Window then
|
|
||||||
SetForegroundWindow(Self.TargetHandle);
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
if TargetMode = w_XWindow then
|
|
||||||
begin;
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
|
|
||||||
{ TODO: Check if Window is valid? }
|
|
||||||
XSetInputFocus(Self.XDisplay,Self.CurWindow,RevertToParent,CurrentTime);
|
|
||||||
XFlush(Self.XDisplay);
|
|
||||||
XSetErrorHandler(Old_Handler);
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
function TMWindow.UpdateDrawBitmap :boolean;
|
|
||||||
var
|
|
||||||
w,h : integer;
|
|
||||||
BmpInfo : Windows.TBitmap;
|
|
||||||
begin
|
|
||||||
GetDimensions(w,h);
|
|
||||||
DrawBitmap.SetSize(w,h);
|
|
||||||
// DrawBitmap.PixelFormat:=
|
|
||||||
DrawBmpW := w;
|
|
||||||
DrawBmpH := h;
|
|
||||||
GetObject(DrawBitmap.Handle, SizeOf(BmpInfo), @BmpInfo);
|
|
||||||
DrawBmpDataPtr := BmpInfo.bmBits;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
// Returns dimensions of the Window
|
|
||||||
procedure TMWindow.GetDimensions(out W, H: Integer);
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
Attrib: TXWindowAttributes;
|
|
||||||
newx,newy : integer;
|
|
||||||
childwindow : x.TWindow;
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
var
|
|
||||||
Rect : TRect;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
if Frozen then
|
|
||||||
begin;
|
|
||||||
w := FrozenSize.x;
|
|
||||||
h := FrozenSize.y;
|
|
||||||
end else
|
|
||||||
case TargetMode of
|
|
||||||
w_BMP :
|
|
||||||
begin
|
|
||||||
w := TargetBitmap.Width;
|
|
||||||
h := TargetBitmap.Height;
|
|
||||||
end;
|
|
||||||
w_Window:
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
GetWindowRect(Self.TargetHandle, Rect);
|
|
||||||
w:= Rect.Right - Rect.Left;
|
|
||||||
h:= Rect.Bottom - Rect.Top;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
w_XWindow:
|
|
||||||
begin
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
if XGetWindowAttributes(Self.XDisplay, Self.CurWindow, @Attrib) <> 0 Then
|
|
||||||
begin
|
|
||||||
{ I don't think we need this XTranslateCoordinates... :D }
|
|
||||||
XTranslateCoordinates(Self.XDisplay, Self.CurWindow, Self.DesktopWindow, 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);
|
|
||||||
{$ELSE}
|
|
||||||
raise Exception.createFMT('GetDimensions: You cannot use ' +
|
|
||||||
'the XImage mode on Windows.', []);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
w_ArrayPtr:
|
|
||||||
begin
|
|
||||||
W := Self.ArraySize.X;
|
|
||||||
H := Self.ArraySize.Y;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TMWindow.GetDimensionBox(out Box : TBox) : boolean;
|
|
||||||
function IntToTBox(x1,y1,x2,y2 : integer) : TBox;inline;
|
|
||||||
begin;
|
|
||||||
result.x1 := x1;
|
|
||||||
result.y1 := y1;
|
|
||||||
result.x2 := x2;
|
|
||||||
result.y2 := y2;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
var
|
|
||||||
Attrib: TXWindowAttributes;
|
|
||||||
newx,newy : integer;
|
|
||||||
childwindow : x.TWindow;
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
var
|
|
||||||
Rect : TRect;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
result := false;
|
|
||||||
case TargetMode of
|
|
||||||
w_Window:
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
result := true;
|
|
||||||
GetWindowRect(Self.TargetHandle, Rect);
|
|
||||||
box := IntToTBox(Rect.Left,Rect.top,Rect.Right - 1,Rect.Bottom - 1);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
w_XWindow:
|
|
||||||
begin
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
result := true;
|
|
||||||
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
|
|
||||||
if XGetWindowAttributes(Self.XDisplay, Self.CurWindow, @Attrib) <> 0 Then
|
|
||||||
begin
|
|
||||||
{ I don't think we need this XTranslateCoordinates... :D }
|
|
||||||
XTranslateCoordinates(Self.XDisplay, Self.CurWindow, Self.DesktopWindow, 0,0, @newx, @newy, @childwindow);
|
|
||||||
box := IntToTBox(Attrib.x,Attrib.y,Attrib.x + Attrib.Width -1,Attrib.y +Attrib.Height-1 );
|
|
||||||
end else
|
|
||||||
box := IntToTBox(-1,-1,-1,-1);
|
|
||||||
XSetErrorHandler(Old_Handler);
|
|
||||||
{$ELSE}
|
|
||||||
raise Exception.createFMT('GetDimensions: You cannot use ' +
|
|
||||||
'the XImage mode on Windows.', []);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Set target to X-Window
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
function TMWindow.SetTarget(XWindow: x.TWindow): integer; overload;
|
|
||||||
var
|
|
||||||
Old_Handler: TXErrorHandler;
|
|
||||||
begin
|
|
||||||
if Self.Frozen then
|
|
||||||
raise Exception.CreateFMT('You cannot set a target when Frozen',[]);
|
|
||||||
OnSetTarget(w_XWindow,Self.TargetMode);
|
|
||||||
Self.CurWindow := XWindow;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
// Set target to Windows Window
|
|
||||||
function TMWindow.SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
|
|
||||||
begin
|
|
||||||
if Self.Frozen then
|
|
||||||
raise Exception.CreateFMT('You cannot set a target when Frozen',[]);
|
|
||||||
if NewType in [ w_XWindow, w_ArrayPtr ] then
|
|
||||||
raise Exception.createFMT('SetTarget: Invalid new type.', []);
|
|
||||||
OnSetTarget(NewType,self.TargetMode);
|
|
||||||
case NewType of
|
|
||||||
w_HDC :
|
|
||||||
begin
|
|
||||||
{$ifdef MSWindows}
|
|
||||||
Self.TargetDC:= Window;
|
|
||||||
{$else}
|
|
||||||
Raise Exception.Create('HDC not supported on linux (yet)');
|
|
||||||
{$endif}
|
|
||||||
end;
|
|
||||||
w_Window :
|
|
||||||
begin;
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
//The old DC is free'd in OnSetTarget.
|
|
||||||
Self.TargetHandle := Window;
|
|
||||||
Self.TargetDC := GetWindowDC(Window);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
UpdateDrawBitmap;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
{
|
|
||||||
This functionality is very BETA.
|
|
||||||
We have no way to send events to a window, so we should probably use the
|
|
||||||
desktop window?
|
|
||||||
|
|
||||||
eg: In mouse/keys: if Self.TargetMode not in [w_Window, w_XWindow], send it
|
|
||||||
to the desktop.
|
|
||||||
}
|
|
||||||
function TMWindow.SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
|
|
||||||
begin
|
|
||||||
if Self.Frozen then
|
|
||||||
raise Exception.CreateFMT('You cannot set a target when Frozen',[]);
|
|
||||||
Self.SetDesktop;//Set the underlaying window to desktop for key-sending etc..
|
|
||||||
OnSetTarget(w_ArrayPtr,self.TargetMode);
|
|
||||||
Self.ArrayPtr := ArrPtr;
|
|
||||||
Self.ArraySize := Size;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Set target to Bitmap, set desktop for keyinput/output
|
|
||||||
function TMWindow.SetTarget(Bitmap: TMufasaBitmap): integer;
|
|
||||||
begin
|
|
||||||
if Self.Frozen then
|
|
||||||
raise Exception.CreateFMT('You cannot set a target when Frozen',[]);
|
|
||||||
OnSetTarget(w_BMP,self.TargetMode);
|
|
||||||
Self.SetDesktop;
|
|
||||||
Self.TargetBitmap := Bitmap;
|
|
||||||
Bitmap.OnDestroy:= @OnTargetBitmapDestroy;
|
|
||||||
end;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,133 +0,0 @@
|
|||||||
unit windowutil;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils,
|
|
||||||
ctypes, // for cint, etc
|
|
||||||
GraphType, // For TRawImage
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
x, xlib, // For X* stuff.
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
mufasatypes;
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage);
|
|
||||||
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
|
|
||||||
{$ENDIF}
|
|
||||||
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
|
|
||||||
{$IFDEF LINUX}
|
|
||||||
|
|
||||||
// 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;
|
|
||||||
|
|
||||||
Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage);
|
|
||||||
Begin
|
|
||||||
RawImage.Init; { Calls raw.Description.Init as well }
|
|
||||||
|
|
||||||
RawImage.Description.PaletteColorCount:=0;
|
|
||||||
RawImage.Description.MaskBitsPerPixel:=0;
|
|
||||||
RawImage.Description.Width := XImg^.width;
|
|
||||||
RawImage.Description.Height:= XImg^.height;
|
|
||||||
|
|
||||||
RawImage.Description.Format := ricfRGBA;
|
|
||||||
|
|
||||||
if XImg^.byte_order = LSBFirst then
|
|
||||||
RawImage.Description.ByteOrder := riboLSBFirst
|
|
||||||
else
|
|
||||||
RawImage.Description.ByteOrder:= riboMSBFirst;
|
|
||||||
|
|
||||||
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
|
|
||||||
|
|
||||||
RawImage.Description.Depth:=XImg^.depth;
|
|
||||||
|
|
||||||
RawImage.Description.BitsPerPixel:=XImg^.bits_per_pixel;
|
|
||||||
|
|
||||||
RawImage.Description.LineOrder:=riloTopToBottom;
|
|
||||||
|
|
||||||
RawImage.Description.LineEnd := rileDWordBoundary;
|
|
||||||
|
|
||||||
RawImage.Description.RedPrec := 8;
|
|
||||||
RawImage.Description.GreenPrec:= 8;
|
|
||||||
RawImage.Description.BluePrec:= 8;
|
|
||||||
RawImage.Description.AlphaPrec:=0;
|
|
||||||
|
|
||||||
|
|
||||||
// Can be adjusted to the XImage RedMask, etc.
|
|
||||||
// For now I just assume the tester uses BGR.
|
|
||||||
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.DataSize := RawImage.Description.Height * RawImage.Description.BitsPerLine;
|
|
||||||
RawImage.Data := PByte(XImg^.data);
|
|
||||||
|
|
||||||
End;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
|
|
||||||
// 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;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user