mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-11 03:45:06 -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',[
|
||||
'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'
|
||||
@ -6,4 +8,4 @@ LazarusResources.Add('TDebugImgForm','FORMDATA',[
|
||||
+'OnHide'#7#8'FormHide'#8'OnResize'#7#10'FormResize'#10'LCLVersion'#6#6'0.9.2'
|
||||
+'9'#0#6'TImage'#9'DrawImage'#4'Left'#2#0#6'Height'#3','#1#3'Top'#2#0#5'Width'
|
||||
+#3#144#1#5'Align'#7#8'alClient'#0#0#0
|
||||
]);
|
||||
]);
|
||||
@ -59,7 +59,7 @@ var
|
||||
implementation
|
||||
|
||||
uses
|
||||
MufasaTypes, math,windowutil,graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
|
||||
MufasaTypes, math, graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
|
||||
{ TDebugImgForm }
|
||||
|
||||
procedure TDebugImgForm.FormCreate(Sender: TObject);
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
<TargetFileExt Value=""/>
|
||||
<Title Value="Simba"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<ActiveEditorIndexAtStart Value="11"/>
|
||||
<ActiveEditorIndexAtStart Value="1"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
@ -36,14 +36,14 @@
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="287">
|
||||
<Units Count="288">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="project1"/>
|
||||
<CursorPos X="12" Y="25"/>
|
||||
<TopLine Value="15"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="205"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
@ -141,7 +141,7 @@
|
||||
<UnitName Value="TestUnit"/>
|
||||
<CursorPos X="99" Y="1797"/>
|
||||
<TopLine Value="1789"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<UsageCount Value="202"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit13>
|
||||
@ -219,9 +219,7 @@
|
||||
<UnitName Value="Window"/>
|
||||
<CursorPos X="1" Y="163"/>
|
||||
<TopLine Value="541"/>
|
||||
<EditorIndex Value="14"/>
|
||||
<UsageCount Value="201"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit23>
|
||||
<Unit24>
|
||||
<Filename Value="../../../cogat/Units/CogatUnits/comptypes.pas"/>
|
||||
@ -233,20 +231,16 @@
|
||||
<Unit25>
|
||||
<Filename Value="../../Units/MMLCore/windowutil.pas"/>
|
||||
<UnitName Value="windowutil"/>
|
||||
<CursorPos X="14" Y="16"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<CursorPos X="1" Y="27"/>
|
||||
<TopLine Value="12"/>
|
||||
<UsageCount Value="100"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit25>
|
||||
<Unit26>
|
||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
||||
<UnitName Value="Input"/>
|
||||
<CursorPos X="1" Y="83"/>
|
||||
<TopLine Value="56"/>
|
||||
<EditorIndex Value="15"/>
|
||||
<UsageCount Value="93"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit26>
|
||||
<Unit27>
|
||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||
@ -274,11 +268,9 @@
|
||||
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="mmlpsthread"/>
|
||||
<CursorPos X="25" Y="261"/>
|
||||
<TopLine Value="24"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<CursorPos X="17" Y="131"/>
|
||||
<TopLine Value="2"/>
|
||||
<UsageCount Value="202"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit30>
|
||||
<Unit31>
|
||||
<Filename Value="../../Units/PascalScript/uPSComponent.pas"/>
|
||||
@ -356,8 +348,8 @@
|
||||
<Filename Value="../../Units/MMLCore/bitmaps.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="bitmaps"/>
|
||||
<CursorPos X="22" Y="681"/>
|
||||
<TopLine Value="671"/>
|
||||
<CursorPos X="85" Y="113"/>
|
||||
<TopLine Value="94"/>
|
||||
<UsageCount Value="200"/>
|
||||
</Unit42>
|
||||
<Unit43>
|
||||
@ -497,8 +489,8 @@
|
||||
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/mouse.inc"/>
|
||||
<CursorPos X="11" Y="26"/>
|
||||
<TopLine Value="12"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<UsageCount Value="15"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<UsageCount Value="16"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit63>
|
||||
<Unit64>
|
||||
@ -543,9 +535,9 @@
|
||||
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="plugins"/>
|
||||
<CursorPos X="3" Y="76"/>
|
||||
<TopLine Value="59"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<CursorPos X="12" Y="68"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="200"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit70>
|
||||
@ -632,9 +624,9 @@
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="windowselector"/>
|
||||
<CursorPos X="20" Y="199"/>
|
||||
<TopLine Value="173"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<CursorPos X="37" Y="34"/>
|
||||
<TopLine Value="12"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<UsageCount Value="201"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit82>
|
||||
@ -1207,7 +1199,7 @@
|
||||
<ComponentState Value="1"/>
|
||||
<CursorPos X="7" Y="73"/>
|
||||
<TopLine Value="55"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<UsageCount Value="200"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit166>
|
||||
@ -1324,9 +1316,7 @@
|
||||
<UnitName Value="MMLKeyInput"/>
|
||||
<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"/>
|
||||
@ -1380,8 +1370,8 @@
|
||||
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/keyboard.inc"/>
|
||||
<CursorPos X="26" Y="43"/>
|
||||
<TopLine Value="13"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="15"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="16"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit191>
|
||||
<Unit192>
|
||||
@ -1494,9 +1484,11 @@
|
||||
<ComponentName Value="DebugImgForm"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="debugimage"/>
|
||||
<CursorPos X="66" Y="17"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<UsageCount Value="202"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit207>
|
||||
<Unit208>
|
||||
<Filename Value="debugimage.lrs"/>
|
||||
@ -1604,7 +1596,7 @@
|
||||
<UnitName Value="framefunctionlist"/>
|
||||
<CursorPos X="26" Y="295"/>
|
||||
<TopLine Value="7"/>
|
||||
<UsageCount Value="161"/>
|
||||
<UsageCount Value="162"/>
|
||||
</Unit223>
|
||||
<Unit224>
|
||||
<Filename Value="../../../usr/local/share/lazarus/lcl/comctrls.pp"/>
|
||||
@ -1659,7 +1651,7 @@
|
||||
<UnitName Value="simpleanalyzer"/>
|
||||
<CursorPos X="52" Y="104"/>
|
||||
<TopLine Value="193"/>
|
||||
<UsageCount Value="148"/>
|
||||
<UsageCount Value="149"/>
|
||||
</Unit231>
|
||||
<Unit232>
|
||||
<Filename Value="../../Units/Misc/mPasLex.pas"/>
|
||||
@ -1717,8 +1709,8 @@
|
||||
</Unit239>
|
||||
<Unit240>
|
||||
<Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/>
|
||||
<CursorPos X="30" Y="109"/>
|
||||
<TopLine Value="98"/>
|
||||
<CursorPos X="25" Y="163"/>
|
||||
<TopLine Value="154"/>
|
||||
<UsageCount Value="23"/>
|
||||
</Unit240>
|
||||
<Unit241>
|
||||
@ -1734,7 +1726,7 @@
|
||||
<UnitName Value="updater"/>
|
||||
<CursorPos X="38" Y="211"/>
|
||||
<TopLine Value="65"/>
|
||||
<UsageCount Value="121"/>
|
||||
<UsageCount Value="122"/>
|
||||
</Unit242>
|
||||
<Unit243>
|
||||
<Filename Value="updateform.pas"/>
|
||||
@ -1745,7 +1737,7 @@
|
||||
<ComponentState Value="1"/>
|
||||
<CursorPos X="111" Y="102"/>
|
||||
<TopLine Value="207"/>
|
||||
<UsageCount Value="116"/>
|
||||
<UsageCount Value="117"/>
|
||||
</Unit243>
|
||||
<Unit244>
|
||||
<Filename Value="../../../Documents/lazarus/lcl/fileutil.pas"/>
|
||||
@ -1866,7 +1858,7 @@
|
||||
<UnitName Value="simbasettings"/>
|
||||
<CursorPos X="26" Y="9"/>
|
||||
<TopLine Value="11"/>
|
||||
<UsageCount Value="79"/>
|
||||
<UsageCount Value="80"/>
|
||||
</Unit261>
|
||||
<Unit262>
|
||||
<Filename Value="../../Units/MMLAddon/settings.pas"/>
|
||||
@ -1911,7 +1903,7 @@
|
||||
<UnitName Value="reportbug"/>
|
||||
<CursorPos X="53" Y="23"/>
|
||||
<TopLine Value="21"/>
|
||||
<UsageCount Value="62"/>
|
||||
<UsageCount Value="63"/>
|
||||
</Unit267>
|
||||
<Unit268>
|
||||
<Filename Value="../../Units/Synapse/synsock.pas"/>
|
||||
@ -1968,7 +1960,7 @@
|
||||
<UnitName Value="newinternets"/>
|
||||
<CursorPos X="80" Y="2"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="58"/>
|
||||
<UsageCount Value="59"/>
|
||||
</Unit275>
|
||||
<Unit276>
|
||||
<Filename Value="reportbug.lrs"/>
|
||||
@ -2014,19 +2006,19 @@
|
||||
<Unit282>
|
||||
<Filename Value="../../Units/MMLCore/iomanager.pas"/>
|
||||
<UnitName Value="IOManager"/>
|
||||
<CursorPos X="35" Y="6"/>
|
||||
<CursorPos X="11" Y="21"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="19"/>
|
||||
<UsageCount Value="20"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit282>
|
||||
<Unit283>
|
||||
<Filename Value="../../Units/MMLCore/os_linux.pas"/>
|
||||
<UnitName Value="os_linux"/>
|
||||
<CursorPos X="10" Y="283"/>
|
||||
<TopLine Value="270"/>
|
||||
<EditorIndex Value="13"/>
|
||||
<UsageCount Value="19"/>
|
||||
<CursorPos X="5" Y="21"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="12"/>
|
||||
<UsageCount Value="20"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit283>
|
||||
<Unit284>
|
||||
@ -2039,10 +2031,10 @@
|
||||
<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"/>
|
||||
<CursorPos X="4" Y="21"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<UsageCount Value="16"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit285>
|
||||
<Unit286>
|
||||
@ -2052,124 +2044,107 @@
|
||||
<TopLine Value="164"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit286>
|
||||
<Unit287>
|
||||
<Filename Value="../../Units/Linux/xinput.pas"/>
|
||||
<UnitName Value="xinput"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit287>
|
||||
</Units>
|
||||
<JumpHistory Count="29" HistoryIndex="28">
|
||||
<JumpHistory Count="23" HistoryIndex="22">
|
||||
<Position1>
|
||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
||||
<Caret Line="263" Column="26" TopLine="233"/>
|
||||
<Filename Value="colourhistory.pas"/>
|
||||
<Caret Line="16" Column="43" TopLine="1"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
||||
<Caret Line="256" Column="32" TopLine="239"/>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<Caret Line="49" Column="1" TopLine="16"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
||||
<Caret Line="277" Column="14" TopLine="261"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1543" Column="61" TopLine="1530"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="../../Units/MMLCore/os_windows.pas"/>
|
||||
<Caret Line="303" Column="41" TopLine="272"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1673" Column="101" TopLine="1656"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="582" Column="60" TopLine="560"/>
|
||||
<Caret Line="1733" Column="57" TopLine="1716"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<Caret Line="49" Column="1" TopLine="16"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1735" Column="36" TopLine="1716"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<Caret Line="32" Column="3" TopLine="15"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1741" Column="36" TopLine="1716"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<Caret Line="49" Column="1" TopLine="16"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1743" Column="21" TopLine="1716"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="colourhistory.pas"/>
|
||||
<Caret Line="16" Column="43" TopLine="1"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1747" Column="40" TopLine="1716"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<Caret Line="49" Column="1" TopLine="16"/>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1748" Column="38" TopLine="1716"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1543" Column="61" TopLine="1530"/>
|
||||
<Caret Line="1750" Column="44" TopLine="1733"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1673" Column="101" TopLine="1656"/>
|
||||
<Caret Line="1752" Column="24" TopLine="1733"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1733" Column="57" TopLine="1716"/>
|
||||
<Caret Line="1764" Column="26" TopLine="1733"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1735" Column="36" TopLine="1716"/>
|
||||
<Caret Line="1768" Column="42" TopLine="1751"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1741" Column="36" TopLine="1716"/>
|
||||
<Caret Line="1786" Column="65" TopLine="1769"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1743" Column="21" TopLine="1716"/>
|
||||
<Caret Line="1789" Column="31" TopLine="1769"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1747" Column="40" TopLine="1716"/>
|
||||
<Caret Line="1791" Column="29" TopLine="1769"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1748" Column="38" TopLine="1716"/>
|
||||
<Caret Line="1793" Column="29" TopLine="1769"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1750" Column="44" TopLine="1733"/>
|
||||
<Caret Line="1794" Column="44" TopLine="1769"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1752" Column="24" TopLine="1733"/>
|
||||
<Caret Line="1795" Column="52" TopLine="1769"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1764" Column="26" TopLine="1733"/>
|
||||
<Caret Line="1796" Column="37" TopLine="1769"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1768" Column="42" TopLine="1751"/>
|
||||
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
|
||||
<Caret Line="199" Column="20" TopLine="173"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="testunit.pas"/>
|
||||
<Caret Line="1786" Column="65" TopLine="1769"/>
|
||||
<Filename Value="debugimage.pas"/>
|
||||
<Caret Line="17" Column="66" TopLine="1"/>
|
||||
</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>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
@ -2181,10 +2156,9 @@
|
||||
<IncludeFiles Value="$(ProjOutDir)/;$(ProjPath)../../Units/MMLAddon/PSInc/"/>
|
||||
<OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/;$(ProjPath)../../Units/Linux/;$(ProjPath)../../Units/Synapse/;$(LazarusDir)/components/mouseandkeyinput/"/>
|
||||
<UnitOutputDirectory Value="$(ProjPath)../../build/$(TargetOS)/"/>
|
||||
<LCLWidgetType Value="win32"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<TargetOS Value="Win32"/>
|
||||
<TargetOS Value="Linux"/>
|
||||
<Optimizations>
|
||||
<VariablesInRegisters Value="True"/>
|
||||
<OptimizationLevel Value="2"/>
|
||||
|
||||
@ -168,7 +168,6 @@ AddFunction(@KeyUp, 'procedure KeyUp(key: Word);');
|
||||
AddFunction(@PressKey, 'procedure PressKey(key: Word);');
|
||||
AddFunction(@SendKeys, 'procedure SendKeys(s: string);');
|
||||
AddFunction(@isKeyDown, 'function IsKeyDown(key: Word): Boolean;');
|
||||
AddFunction(@GetKeyCode, 'function GetKeyCode(Key : char) : byte');
|
||||
|
||||
{ OCR}
|
||||
SetCurrSection('OCR');
|
||||
|
||||
@ -129,7 +129,6 @@ uses
|
||||
math, //Maths!
|
||||
internets, // internets
|
||||
strutils,
|
||||
input,
|
||||
tpa, //Tpa stuff
|
||||
forms,//Forms
|
||||
lclintf; // for GetTickCount and others.
|
||||
|
||||
@ -32,7 +32,6 @@ uses
|
||||
ctypes,
|
||||
{$IFDEF MSWINDOWS} os_windows, {$ENDIF}
|
||||
{$IFDEF LINUX} os_linux, {$ENDIF}
|
||||
windowutil,
|
||||
controls,
|
||||
graphics,
|
||||
forms,
|
||||
|
||||
@ -110,13 +110,49 @@ type
|
||||
destructor Destroy;override;
|
||||
end;
|
||||
|
||||
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Windowutil,paszlib,DCPbase64,math,
|
||||
paszlib,DCPbase64,math,
|
||||
colour_conv,IOManager,mufasatypesutil,tpa;
|
||||
|
||||
// Needs more fixing. We need to either copy the memory ourself, or somehow
|
||||
// find a TRawImage feature to skip X bytes after X bytes read. (Most likely a
|
||||
// feature)
|
||||
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
|
||||
Begin
|
||||
RawImage.Init; { Calls raw.Description.Init as well }
|
||||
|
||||
RawImage.Description.PaletteColorCount:=0;
|
||||
RawImage.Description.MaskBitsPerPixel:=0;
|
||||
RawImage.Description.Width := Size.X;
|
||||
RawImage.Description.Height:= Size.Y;
|
||||
|
||||
RawImage.Description.Format := ricfRGBA;
|
||||
RawImage.Description.ByteOrder := riboLSBFirst;
|
||||
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
|
||||
RawImage.Description.Depth:=24;
|
||||
RawImage.Description.BitsPerPixel:=32;
|
||||
RawImage.Description.LineOrder:=riloTopToBottom;
|
||||
RawImage.Description.LineEnd := rileDWordBoundary;
|
||||
|
||||
RawImage.Description.RedPrec := 8;
|
||||
RawImage.Description.GreenPrec:= 8;
|
||||
RawImage.Description.BluePrec:= 8;
|
||||
RawImage.Description.AlphaPrec:=0;
|
||||
|
||||
|
||||
RawImage.Description.RedShift:=16;
|
||||
RawImage.Description.GreenShift:=8;
|
||||
RawImage.Description.BlueShift:=0;
|
||||
|
||||
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
|
||||
* (RawImage.Description.bitsperpixel shr 3);
|
||||
RawImage.Data := PByte(Ptr);
|
||||
End;
|
||||
|
||||
function Min(a,b:integer) : integer;
|
||||
begin
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
interface
|
||||
@ -55,11 +78,26 @@ interface
|
||||
screennum: integer;
|
||||
desktop: x.TWindow;
|
||||
end;
|
||||
|
||||
|
||||
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl;
|
||||
|
||||
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
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
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