mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-28 12:02:15 -05:00
PS Added
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@38 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond
parent
9a2b50ef82
commit
6f80c64d9c
@ -7,7 +7,7 @@
|
|||||||
<TargetFileExt Value=""/>
|
<TargetFileExt Value=""/>
|
||||||
<Title Value="Mufasa Stand Alone"/>
|
<Title Value="Mufasa Stand Alone"/>
|
||||||
<UseXPManifest Value="True"/>
|
<UseXPManifest Value="True"/>
|
||||||
<ActiveEditorIndexAtStart Value="9"/>
|
<ActiveEditorIndexAtStart Value="8"/>
|
||||||
</General>
|
</General>
|
||||||
<VersionInfo>
|
<VersionInfo>
|
||||||
<ProjectVersion Value=""/>
|
<ProjectVersion Value=""/>
|
||||||
@ -24,20 +24,24 @@
|
|||||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
</local>
|
</local>
|
||||||
</RunParams>
|
</RunParams>
|
||||||
<RequiredPackages Count="1">
|
<RequiredPackages Count="2">
|
||||||
<Item1>
|
<Item1>
|
||||||
<PackageName Value="LCL"/>
|
<PackageName Value="SynEdit"/>
|
||||||
|
<MinVersion Major="1" Valid="True"/>
|
||||||
</Item1>
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item2>
|
||||||
</RequiredPackages>
|
</RequiredPackages>
|
||||||
<Units Count="50">
|
<Units Count="64">
|
||||||
<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="11"/>
|
<CursorPos X="13" Y="17"/>
|
||||||
<TopLine Value="1"/>
|
<TopLine Value="7"/>
|
||||||
<EditorIndex Value="0"/>
|
<EditorIndex Value="0"/>
|
||||||
<UsageCount Value="65"/>
|
<UsageCount Value="70"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit0>
|
</Unit0>
|
||||||
<Unit1>
|
<Unit1>
|
||||||
@ -166,10 +170,10 @@
|
|||||||
<HasResources Value="True"/>
|
<HasResources Value="True"/>
|
||||||
<ResourceBaseClass Value="Form"/>
|
<ResourceBaseClass Value="Form"/>
|
||||||
<UnitName Value="TestUnit"/>
|
<UnitName Value="TestUnit"/>
|
||||||
<CursorPos X="26" Y="266"/>
|
<CursorPos X="19" Y="271"/>
|
||||||
<TopLine Value="241"/>
|
<TopLine Value="259"/>
|
||||||
<EditorIndex Value="5"/>
|
<EditorIndex Value="7"/>
|
||||||
<UsageCount Value="31"/>
|
<UsageCount Value="36"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit18>
|
</Unit18>
|
||||||
<Unit19>
|
<Unit19>
|
||||||
@ -298,20 +302,20 @@
|
|||||||
<Filename Value="../../Units/MMLCore/client.pas"/>
|
<Filename Value="../../Units/MMLCore/client.pas"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="Client"/>
|
<UnitName Value="Client"/>
|
||||||
<CursorPos X="46" Y="39"/>
|
<CursorPos X="25" Y="4"/>
|
||||||
<TopLine Value="1"/>
|
<TopLine Value="4"/>
|
||||||
<EditorIndex Value="3"/>
|
<EditorIndex Value="5"/>
|
||||||
<UsageCount Value="30"/>
|
<UsageCount Value="35"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit37>
|
</Unit37>
|
||||||
<Unit38>
|
<Unit38>
|
||||||
<Filename Value="../../Units/MMLCore/mufasatypes.pas"/>
|
<Filename Value="../../Units/MMLCore/mufasatypes.pas"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="MufasaTypes"/>
|
<UnitName Value="MufasaTypes"/>
|
||||||
<CursorPos X="3" Y="16"/>
|
<CursorPos X="4" Y="26"/>
|
||||||
<TopLine Value="1"/>
|
<TopLine Value="12"/>
|
||||||
<EditorIndex Value="2"/>
|
<EditorIndex Value="4"/>
|
||||||
<UsageCount Value="30"/>
|
<UsageCount Value="35"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit38>
|
</Unit38>
|
||||||
<Unit39>
|
<Unit39>
|
||||||
@ -327,22 +331,20 @@
|
|||||||
<UnitName Value="files"/>
|
<UnitName Value="files"/>
|
||||||
<CursorPos X="62" Y="61"/>
|
<CursorPos X="62" Y="61"/>
|
||||||
<TopLine Value="46"/>
|
<TopLine Value="46"/>
|
||||||
<EditorIndex Value="7"/>
|
<UsageCount Value="36"/>
|
||||||
<UsageCount Value="31"/>
|
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit40>
|
</Unit40>
|
||||||
<Unit41>
|
<Unit41>
|
||||||
<Filename Value="../../Units/MMLCore/window.pas"/>
|
<Filename Value="../../Units/MMLCore/window.pas"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="Window"/>
|
<UnitName Value="Window"/>
|
||||||
<CursorPos X="35" Y="187"/>
|
<CursorPos X="8" Y="262"/>
|
||||||
<TopLine Value="174"/>
|
<TopLine Value="255"/>
|
||||||
<EditorIndex Value="4"/>
|
<EditorIndex Value="6"/>
|
||||||
<UsageCount Value="30"/>
|
<UsageCount Value="35"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit41>
|
</Unit41>
|
||||||
<Unit42>
|
<Unit42>
|
||||||
<Filename Value="../../../../Documents/lazarus/lcl/forms.pp"/>
|
<Filename Value="../../../Documents/lazarus/lcl/forms.pp"/>
|
||||||
<UnitName Value="Forms"/>
|
<UnitName Value="Forms"/>
|
||||||
<CursorPos X="15" Y="1236"/>
|
<CursorPos X="15" Y="1236"/>
|
||||||
<TopLine Value="981"/>
|
<TopLine Value="981"/>
|
||||||
@ -360,27 +362,23 @@
|
|||||||
<UnitName Value="windowutil"/>
|
<UnitName Value="windowutil"/>
|
||||||
<CursorPos X="39" Y="19"/>
|
<CursorPos X="39" Y="19"/>
|
||||||
<TopLine Value="9"/>
|
<TopLine Value="9"/>
|
||||||
<EditorIndex Value="6"/>
|
<UsageCount Value="15"/>
|
||||||
<UsageCount Value="14"/>
|
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit44>
|
</Unit44>
|
||||||
<Unit45>
|
<Unit45>
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
<Filename Value="../../Units/MMLCore/input.pas"/>
|
||||||
<UnitName Value="Input"/>
|
<UnitName Value="Input"/>
|
||||||
<CursorPos X="39" Y="203"/>
|
<CursorPos X="39" Y="203"/>
|
||||||
<TopLine Value="187"/>
|
<TopLine Value="187"/>
|
||||||
<EditorIndex Value="8"/>
|
<UsageCount Value="14"/>
|
||||||
<UsageCount Value="13"/>
|
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit45>
|
</Unit45>
|
||||||
<Unit46>
|
<Unit46>
|
||||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="finder"/>
|
<UnitName Value="finder"/>
|
||||||
<CursorPos X="24" Y="130"/>
|
<CursorPos X="24" Y="130"/>
|
||||||
<TopLine Value="99"/>
|
<TopLine Value="111"/>
|
||||||
<EditorIndex Value="1"/>
|
<EditorIndex Value="3"/>
|
||||||
<UsageCount Value="23"/>
|
<UsageCount Value="28"/>
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
</Unit46>
|
</Unit46>
|
||||||
<Unit47>
|
<Unit47>
|
||||||
@ -394,136 +392,195 @@
|
|||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="MMLThread"/>
|
<UnitName Value="MMLThread"/>
|
||||||
<CursorPos X="49" Y="20"/>
|
<CursorPos X="132" Y="5"/>
|
||||||
<TopLine Value="1"/>
|
<TopLine Value="1"/>
|
||||||
<EditorIndex Value="9"/>
|
<UsageCount Value="26"/>
|
||||||
<UsageCount Value="21"/>
|
|
||||||
<Loaded Value="True"/>
|
|
||||||
</Unit48>
|
</Unit48>
|
||||||
<Unit49>
|
<Unit49>
|
||||||
<Filename Value="../../../../Documents/fpc/rtl/objpas/classes/classesh.inc"/>
|
<Filename Value="../../../Documents/fpc/rtl/objpas/classes/classesh.inc"/>
|
||||||
<CursorPos X="27" Y="1430"/>
|
<CursorPos X="27" Y="1430"/>
|
||||||
<TopLine Value="1422"/>
|
<TopLine Value="1422"/>
|
||||||
<UsageCount Value="10"/>
|
<UsageCount Value="10"/>
|
||||||
</Unit49>
|
</Unit49>
|
||||||
|
<Unit50>
|
||||||
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="mmlpsthread"/>
|
||||||
|
<CursorPos X="20" Y="156"/>
|
||||||
|
<TopLine Value="150"/>
|
||||||
|
<EditorIndex Value="8"/>
|
||||||
|
<UsageCount Value="24"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit50>
|
||||||
|
<Unit51>
|
||||||
|
<Filename Value="../../Units/PascalScript/uPSComponent.pas"/>
|
||||||
|
<UnitName Value="uPSComponent"/>
|
||||||
|
<CursorPos X="21" Y="193"/>
|
||||||
|
<TopLine Value="183"/>
|
||||||
|
<EditorIndex Value="13"/>
|
||||||
|
<UsageCount Value="13"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit51>
|
||||||
|
<Unit52>
|
||||||
|
<Filename Value="../../../FPC/FPCCheckout/rtl/objpas/classes/classesh.inc"/>
|
||||||
|
<CursorPos X="94" Y="494"/>
|
||||||
|
<TopLine Value="489"/>
|
||||||
|
<EditorIndex Value="12"/>
|
||||||
|
<UsageCount Value="13"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit52>
|
||||||
|
<Unit53>
|
||||||
|
<Filename Value="../../../FPC/FPCCheckout/rtl/objpas/types.pp"/>
|
||||||
|
<UnitName Value="types"/>
|
||||||
|
<CursorPos X="1" Y="1"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="11"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit53>
|
||||||
|
<Unit54>
|
||||||
|
<Filename Value="../../../FPC/FPCCheckout/rtl/objpas/typinfo.pp"/>
|
||||||
|
<UnitName Value="typinfo"/>
|
||||||
|
<CursorPos X="1" Y="1"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="10"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit54>
|
||||||
|
<Unit55>
|
||||||
|
<Filename Value="../../Units/PascalScript/uPSC_forms.pas"/>
|
||||||
|
<UnitName Value="uPSC_forms"/>
|
||||||
|
<CursorPos X="1" Y="1"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="9"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit55>
|
||||||
|
<Unit56>
|
||||||
|
<Filename Value="project1.lrs"/>
|
||||||
|
<CursorPos X="20" Y="1"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="1"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit56>
|
||||||
|
<Unit57>
|
||||||
|
<Filename Value="../../../lazarus/lcl/lresources.pp"/>
|
||||||
|
<UnitName Value="LResources"/>
|
||||||
|
<CursorPos X="3" Y="1396"/>
|
||||||
|
<TopLine Value="1396"/>
|
||||||
|
<EditorIndex Value="2"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit57>
|
||||||
|
<Unit58>
|
||||||
|
<Filename Value="../../../lazarus/components/synedit/synmemo.pas"/>
|
||||||
|
<UnitName Value="SynMemo"/>
|
||||||
|
<CursorPos X="16" Y="150"/>
|
||||||
|
<TopLine Value="31"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit58>
|
||||||
|
<Unit59>
|
||||||
|
<Filename Value="../../../lazarus/components/synedit/syneditmiscclasses.pp"/>
|
||||||
|
<UnitName Value="SynEditMiscClasses"/>
|
||||||
|
<CursorPos X="29" Y="100"/>
|
||||||
|
<TopLine Value="92"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit59>
|
||||||
|
<Unit60>
|
||||||
|
<Filename Value="../../../lazarus/components/synedit/synedit.pp"/>
|
||||||
|
<UnitName Value="SynEdit"/>
|
||||||
|
<CursorPos X="22" Y="1531"/>
|
||||||
|
<TopLine Value="1523"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit60>
|
||||||
|
<Unit61>
|
||||||
|
<Filename Value="../../../lazarus/components/synedit/syngutterchanges.pas"/>
|
||||||
|
<UnitName Value="SynGutterChanges"/>
|
||||||
|
<CursorPos X="34" Y="126"/>
|
||||||
|
<TopLine Value="118"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit61>
|
||||||
|
<Unit62>
|
||||||
|
<Filename Value="../../../lazarus/components/synedit/syneditlines.pas"/>
|
||||||
|
<UnitName Value="SynEditLines"/>
|
||||||
|
<CursorPos X="21" Y="48"/>
|
||||||
|
<TopLine Value="40"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit62>
|
||||||
|
<Unit63>
|
||||||
|
<Filename Value="../../../lazarus/components/synedit/synedittextbase.pas"/>
|
||||||
|
<UnitName Value="SynEditTextBase"/>
|
||||||
|
<CursorPos X="3" Y="75"/>
|
||||||
|
<TopLine Value="124"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit63>
|
||||||
</Units>
|
</Units>
|
||||||
<JumpHistory Count="29" HistoryIndex="28">
|
<JumpHistory Count="16" HistoryIndex="15">
|
||||||
<Position1>
|
<Position1>
|
||||||
<Filename Value="../../Units/MMLCore/windowutil.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="34" Column="34" TopLine="24"/>
|
<Caret Line="274" Column="26" TopLine="258"/>
|
||||||
</Position1>
|
</Position1>
|
||||||
<Position2>
|
<Position2>
|
||||||
<Filename Value="../../Units/MMLCore/files.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1" Column="1" TopLine="1"/>
|
<Caret Line="271" Column="35" TopLine="258"/>
|
||||||
</Position2>
|
</Position2>
|
||||||
<Position3>
|
<Position3>
|
||||||
<Filename Value="../../Units/MMLCore/files.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="213" Column="5" TopLine="203"/>
|
<Caret Line="271" Column="14" TopLine="258"/>
|
||||||
</Position3>
|
</Position3>
|
||||||
<Position4>
|
<Position4>
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="1" Column="1" TopLine="1"/>
|
<Caret Line="271" Column="19" TopLine="258"/>
|
||||||
</Position4>
|
</Position4>
|
||||||
<Position5>
|
<Position5>
|
||||||
<Filename Value="../../Units/MMLCore/client.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="8" Column="53" TopLine="1"/>
|
<Caret Line="22" Column="47" TopLine="22"/>
|
||||||
</Position5>
|
</Position5>
|
||||||
<Position6>
|
<Position6>
|
||||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="35" Column="5" TopLine="31"/>
|
<Caret Line="30" Column="45" TopLine="22"/>
|
||||||
</Position6>
|
</Position6>
|
||||||
<Position7>
|
<Position7>
|
||||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="92" Column="48" TopLine="75"/>
|
<Caret Line="8" Column="73" TopLine="22"/>
|
||||||
</Position7>
|
</Position7>
|
||||||
<Position8>
|
<Position8>
|
||||||
<Filename Value="../../Units/MMLCore/finder.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="84" Column="12" TopLine="64"/>
|
<Caret Line="30" Column="45" TopLine="22"/>
|
||||||
</Position8>
|
</Position8>
|
||||||
<Position9>
|
<Position9>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="84" Column="18" TopLine="69"/>
|
<Caret Line="225" Column="50" TopLine="217"/>
|
||||||
</Position9>
|
</Position9>
|
||||||
<Position10>
|
<Position10>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="88" Column="30" TopLine="65"/>
|
<Caret Line="227" Column="5" TopLine="219"/>
|
||||||
</Position10>
|
</Position10>
|
||||||
<Position11>
|
<Position11>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="87" Column="16" TopLine="69"/>
|
<Caret Line="53" Column="19" TopLine="40"/>
|
||||||
</Position11>
|
</Position11>
|
||||||
<Position12>
|
<Position12>
|
||||||
<Filename Value="testunit.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="90" Column="41" TopLine="75"/>
|
<Caret Line="279" Column="3" TopLine="270"/>
|
||||||
</Position12>
|
</Position12>
|
||||||
<Position13>
|
<Position13>
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
<Filename Value="testunit.pas"/>
|
||||||
<Caret Line="201" Column="18" TopLine="1"/>
|
<Caret Line="271" Column="19" TopLine="259"/>
|
||||||
</Position13>
|
</Position13>
|
||||||
<Position14>
|
<Position14>
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="209" Column="34" TopLine="195"/>
|
<Caret Line="65" Column="26" TopLine="22"/>
|
||||||
</Position14>
|
</Position14>
|
||||||
<Position15>
|
<Position15>
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="215" Column="65" TopLine="193"/>
|
<Caret Line="49" Column="15" TopLine="21"/>
|
||||||
</Position15>
|
</Position15>
|
||||||
<Position16>
|
<Position16>
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
|
||||||
<Caret Line="202" Column="41" TopLine="182"/>
|
<Caret Line="55" Column="16" TopLine="26"/>
|
||||||
</Position16>
|
</Position16>
|
||||||
<Position17>
|
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
|
||||||
<Caret Line="203" Column="39" TopLine="183"/>
|
|
||||||
</Position17>
|
|
||||||
<Position18>
|
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
|
||||||
<Caret Line="202" Column="39" TopLine="183"/>
|
|
||||||
</Position18>
|
|
||||||
<Position19>
|
|
||||||
<Filename Value="../../Units/MMLCore/input.pas"/>
|
|
||||||
<Caret Line="188" Column="63" TopLine="172"/>
|
|
||||||
</Position19>
|
|
||||||
<Position20>
|
|
||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
|
||||||
<Caret Line="31" Column="21" TopLine="7"/>
|
|
||||||
</Position20>
|
|
||||||
<Position21>
|
|
||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
|
||||||
<Caret Line="34" Column="6" TopLine="12"/>
|
|
||||||
</Position21>
|
|
||||||
<Position22>
|
|
||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
|
||||||
<Caret Line="40" Column="12" TopLine="13"/>
|
|
||||||
</Position22>
|
|
||||||
<Position23>
|
|
||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
|
||||||
<Caret Line="36" Column="38" TopLine="14"/>
|
|
||||||
</Position23>
|
|
||||||
<Position24>
|
|
||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
|
||||||
<Caret Line="42" Column="5" TopLine="14"/>
|
|
||||||
</Position24>
|
|
||||||
<Position25>
|
|
||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
|
||||||
<Caret Line="41" Column="38" TopLine="18"/>
|
|
||||||
</Position25>
|
|
||||||
<Position26>
|
|
||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
|
||||||
<Caret Line="42" Column="47" TopLine="20"/>
|
|
||||||
</Position26>
|
|
||||||
<Position27>
|
|
||||||
<Filename Value="../../Units/MMLAddon/mmlthread.pas"/>
|
|
||||||
<Caret Line="29" Column="12" TopLine="12"/>
|
|
||||||
</Position27>
|
|
||||||
<Position28>
|
|
||||||
<Filename Value="testunit.pas"/>
|
|
||||||
<Caret Line="250" Column="18" TopLine="57"/>
|
|
||||||
</Position28>
|
|
||||||
<Position29>
|
|
||||||
<Filename Value="testunit.pas"/>
|
|
||||||
<Caret Line="263" Column="20" TopLine="239"/>
|
|
||||||
</Position29>
|
|
||||||
</JumpHistory>
|
</JumpHistory>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
@ -533,7 +590,7 @@
|
|||||||
</Target>
|
</Target>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<IncludeFiles Value="$(ProjOutDir)/"/>
|
<IncludeFiles Value="$(ProjOutDir)/"/>
|
||||||
<OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;/home/merlijn/Programs/mufasa/Units/MMLAddon/"/>
|
<OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<CodeGeneration>
|
<CodeGeneration>
|
||||||
<Optimizations>
|
<Optimizations>
|
||||||
|
|||||||
@ -8,7 +8,7 @@ uses
|
|||||||
{$ENDIF}{$ENDIF}
|
{$ENDIF}{$ENDIF}
|
||||||
Interfaces, // this includes the LCL widgetset
|
Interfaces, // this includes the LCL widgetset
|
||||||
Forms, LResources, Window, files, MufasaTypes, Client, TestUnit, finder,
|
Forms, LResources, Window, files, MufasaTypes, Client, TestUnit, finder,
|
||||||
MMLThread;
|
MMLThread, mmlpsthread;
|
||||||
|
|
||||||
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
|
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
|
||||||
|
|
||||||
@ -16,6 +16,7 @@ begin
|
|||||||
Application.Title:='Mufasa Stand Alone';
|
Application.Title:='Mufasa Stand Alone';
|
||||||
{$I project1.lrs}
|
{$I project1.lrs}
|
||||||
Application.Initialize;
|
Application.Initialize;
|
||||||
|
|
||||||
Application.CreateForm(TForm1, Form1);
|
Application.CreateForm(TForm1, Form1);
|
||||||
Application.Run;
|
Application.Run;
|
||||||
end.
|
end.
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@ -5,6 +5,282 @@ LazarusResources.Add('TForm1','FORMDATA',[
|
|||||||
+'dth'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientH'
|
+'dth'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientH'
|
||||||
+'eight'#3#15#2#11'ClientWidth'#3#11#3#8'Position'#7#14'poScreenCenter'#10'LC'
|
+'eight'#3#15#2#11'ClientWidth'#3#11#3#8'Position'#7#14'poScreenCenter'#10'LC'
|
||||||
+'LVersion'#6#6'0.9.29'#0#7'TButton'#7'Button1'#4'Left'#2#8#6'Height'#2#25#3
|
+'LVersion'#6#6'0.9.29'#0#7'TButton'#7'Button1'#4'Left'#2#8#6'Height'#2#25#3
|
||||||
+'Top'#2#16#5'Width'#2'K'#7'Caption'#6#7'Button1'#7'OnClick'#7#12'Button1Clic'
|
+'Top'#2#16#5'Width'#2'K'#7'Caption'#6#3'Run'#7'OnClick'#7#12'Button1Click'#8
|
||||||
+'k'#8'TabOrder'#2#0#0#0#0
|
+'TabOrder'#2#0#0#0#8'TSynEdit'#8'SynEdit1'#4'Left'#2#8#6'Height'#3'('#1#3'To'
|
||||||
|
+'p'#2'@'#5'Width'#3#216#2#5'Align'#7#8'alCustom'#11'Font.Height'#2#243#9'Fon'
|
||||||
|
+'t.Name'#6#11'Courier New'#10'Font.Pitch'#7#7'fpFixed'#12'Font.Quality'#7#16
|
||||||
|
+'fqNonAntialiased'#11'ParentColor'#8#10'ParentFont'#8#8'TabOrder'#2#1#12'Gut'
|
||||||
|
+'ter.Width'#2'9'#19'Gutter.MouseActions'#14#1#5'Shift'#11#0#9'ShiftMask'#11#0
|
||||||
|
+#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'C'
|
||||||
|
+'ommand'#2#13#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0
|
||||||
|
+#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10'ClickCount'#7#8'ccSingle'#8'Cli'
|
||||||
|
+'ckDir'#7#4'cdUp'#7'Command'#2#12#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2
|
||||||
|
+#0#0#0#11'Highlighter'#7#17'SynFreePascalSyn1'#10'Keystrokes'#14#1#7'Command'
|
||||||
|
+#7#4'ecUp'#8'ShortCut'#2'&'#0#1#7'Command'#7#7'ecSelUp'#8'ShortCut'#3'& '#0#1
|
||||||
|
+#7'Command'#7#10'ecScrollUp'#8'ShortCut'#3'&@'#0#1#7'Command'#7#6'ecDown'#8
|
||||||
|
+'ShortCut'#2'('#0#1#7'Command'#7#9'ecSelDown'#8'ShortCut'#3'( '#0#1#7'Comman'
|
||||||
|
+'d'#7#12'ecScrollDown'#8'ShortCut'#3'(@'#0#1#7'Command'#7#6'ecLeft'#8'ShortC'
|
||||||
|
+'ut'#2'%'#0#1#7'Command'#7#9'ecSelLeft'#8'ShortCut'#3'% '#0#1#7'Command'#7#10
|
||||||
|
+'ecWordLeft'#8'ShortCut'#3'%@'#0#1#7'Command'#7#13'ecSelWordLeft'#8'ShortCut'
|
||||||
|
+#3'%`'#0#1#7'Command'#7#7'ecRight'#8'ShortCut'#2''''#0#1#7'Command'#7#10'ecS'
|
||||||
|
+'elRight'#8'ShortCut'#3''' '#0#1#7'Command'#7#11'ecWordRight'#8'ShortCut'#3
|
||||||
|
+'''@'#0#1#7'Command'#7#14'ecSelWordRight'#8'ShortCut'#3'''`'#0#1#7'Command'#7
|
||||||
|
+#10'ecPageDown'#8'ShortCut'#2'"'#0#1#7'Command'#7#13'ecSelPageDown'#8'ShortC'
|
||||||
|
+'ut'#3'" '#0#1#7'Command'#7#12'ecPageBottom'#8'ShortCut'#3'"@'#0#1#7'Command'
|
||||||
|
+#7#15'ecSelPageBottom'#8'ShortCut'#3'"`'#0#1#7'Command'#7#8'ecPageUp'#8'Shor'
|
||||||
|
+'tCut'#2'!'#0#1#7'Command'#7#11'ecSelPageUp'#8'ShortCut'#3'! '#0#1#7'Command'
|
||||||
|
+#7#9'ecPageTop'#8'ShortCut'#3'!@'#0#1#7'Command'#7#12'ecSelPageTop'#8'ShortC'
|
||||||
|
+'ut'#3'!`'#0#1#7'Command'#7#11'ecLineStart'#8'ShortCut'#2'$'#0#1#7'Command'#7
|
||||||
|
+#14'ecSelLineStart'#8'ShortCut'#3'$ '#0#1#7'Command'#7#11'ecEditorTop'#8'Sho'
|
||||||
|
+'rtCut'#3'$@'#0#1#7'Command'#7#14'ecSelEditorTop'#8'ShortCut'#3'$`'#0#1#7'Co'
|
||||||
|
+'mmand'#7#9'ecLineEnd'#8'ShortCut'#2'#'#0#1#7'Command'#7#12'ecSelLineEnd'#8
|
||||||
|
+'ShortCut'#3'# '#0#1#7'Command'#7#14'ecEditorBottom'#8'ShortCut'#3'#@'#0#1#7
|
||||||
|
+'Command'#7#17'ecSelEditorBottom'#8'ShortCut'#3'#`'#0#1#7'Command'#7#12'ecTo'
|
||||||
|
+'ggleMode'#8'ShortCut'#2'-'#0#1#7'Command'#7#6'ecCopy'#8'ShortCut'#3'-@'#0#1
|
||||||
|
+#7'Command'#7#7'ecPaste'#8'ShortCut'#3'- '#0#1#7'Command'#7#12'ecDeleteChar'
|
||||||
|
+#8'ShortCut'#2'.'#0#1#7'Command'#7#5'ecCut'#8'ShortCut'#3'. '#0#1#7'Command'
|
||||||
|
+#7#16'ecDeleteLastChar'#8'ShortCut'#2#8#0#1#7'Command'#7#16'ecDeleteLastChar'
|
||||||
|
+#8'ShortCut'#3#8' '#0#1#7'Command'#7#16'ecDeleteLastWord'#8'ShortCut'#3#8'@'
|
||||||
|
+#0#1#7'Command'#7#6'ecUndo'#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#7#6'ecRed'
|
||||||
|
+'o'#8'ShortCut'#4#8#160#0#0#0#1#7'Command'#7#11'ecLineBreak'#8'ShortCut'#2#13
|
||||||
|
+#0#1#7'Command'#7#11'ecSelectAll'#8'ShortCut'#3'A@'#0#1#7'Command'#7#6'ecCop'
|
||||||
|
+'y'#8'ShortCut'#3'C@'#0#1#7'Command'#7#13'ecBlockIndent'#8'ShortCut'#3'I`'#0
|
||||||
|
+#1#7'Command'#7#11'ecLineBreak'#8'ShortCut'#3'M@'#0#1#7'Command'#7#12'ecInse'
|
||||||
|
+'rtLine'#8'ShortCut'#3'N@'#0#1#7'Command'#7#12'ecDeleteWord'#8'ShortCut'#3'T'
|
||||||
|
+'@'#0#1#7'Command'#7#15'ecBlockUnindent'#8'ShortCut'#3'U`'#0#1#7'Command'#7#7
|
||||||
|
+'ecPaste'#8'ShortCut'#3'V@'#0#1#7'Command'#7#5'ecCut'#8'ShortCut'#3'X@'#0#1#7
|
||||||
|
+'Command'#7#12'ecDeleteLine'#8'ShortCut'#3'Y@'#0#1#7'Command'#7#11'ecDeleteE'
|
||||||
|
+'OL'#8'ShortCut'#3'Y`'#0#1#7'Command'#7#6'ecUndo'#8'ShortCut'#3'Z@'#0#1#7'Co'
|
||||||
|
+'mmand'#7#6'ecRedo'#8'ShortCut'#3'Z`'#0#1#7'Command'#7#13'ecGotoMarker0'#8'S'
|
||||||
|
+'hortCut'#3'0@'#0#1#7'Command'#7#13'ecGotoMarker1'#8'ShortCut'#3'1@'#0#1#7'C'
|
||||||
|
+'ommand'#7#13'ecGotoMarker2'#8'ShortCut'#3'2@'#0#1#7'Command'#7#13'ecGotoMar'
|
||||||
|
+'ker3'#8'ShortCut'#3'3@'#0#1#7'Command'#7#13'ecGotoMarker4'#8'ShortCut'#3'4@'
|
||||||
|
+#0#1#7'Command'#7#13'ecGotoMarker5'#8'ShortCut'#3'5@'#0#1#7'Command'#7#13'ec'
|
||||||
|
+'GotoMarker6'#8'ShortCut'#3'6@'#0#1#7'Command'#7#13'ecGotoMarker7'#8'ShortCu'
|
||||||
|
+'t'#3'7@'#0#1#7'Command'#7#13'ecGotoMarker8'#8'ShortCut'#3'8@'#0#1#7'Command'
|
||||||
|
+#7#13'ecGotoMarker9'#8'ShortCut'#3'9@'#0#1#7'Command'#7#12'ecSetMarker0'#8'S'
|
||||||
|
+'hortCut'#3'0`'#0#1#7'Command'#7#12'ecSetMarker1'#8'ShortCut'#3'1`'#0#1#7'Co'
|
||||||
|
+'mmand'#7#12'ecSetMarker2'#8'ShortCut'#3'2`'#0#1#7'Command'#7#12'ecSetMarker'
|
||||||
|
+'3'#8'ShortCut'#3'3`'#0#1#7'Command'#7#12'ecSetMarker4'#8'ShortCut'#3'4`'#0#1
|
||||||
|
+#7'Command'#7#12'ecSetMarker5'#8'ShortCut'#3'5`'#0#1#7'Command'#7#12'ecSetMa'
|
||||||
|
+'rker6'#8'ShortCut'#3'6`'#0#1#7'Command'#7#12'ecSetMarker7'#8'ShortCut'#3'7`'
|
||||||
|
+#0#1#7'Command'#7#12'ecSetMarker8'#8'ShortCut'#3'8`'#0#1#7'Command'#7#12'ecS'
|
||||||
|
,'etMarker9'#8'ShortCut'#3'9`'#0#1#7'Command'#7#12'EcFoldLevel1'#8'ShortCut'#4
|
||||||
|
+'1'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel2'#8'ShortCut'#4'2'#160#0#0#0#1#7
|
||||||
|
+'Command'#7#12'EcFoldLevel1'#8'ShortCut'#4'3'#160#0#0#0#1#7'Command'#7#12'Ec'
|
||||||
|
+'FoldLevel1'#8'ShortCut'#4'4'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel1'#8'Sh'
|
||||||
|
+'ortCut'#4'5'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel6'#8'ShortCut'#4'6'#160
|
||||||
|
+#0#0#0#1#7'Command'#7#12'EcFoldLevel7'#8'ShortCut'#4'7'#160#0#0#0#1#7'Comman'
|
||||||
|
+'d'#7#12'EcFoldLevel8'#8'ShortCut'#4'8'#160#0#0#0#1#7'Command'#7#12'EcFoldLe'
|
||||||
|
+'vel9'#8'ShortCut'#4'9'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel0'#8'ShortCut'
|
||||||
|
+#4'0'#160#0#0#0#1#7'Command'#7#13'EcFoldCurrent'#8'ShortCut'#4'-'#160#0#0#0#1
|
||||||
|
+#7'Command'#7#15'EcUnFoldCurrent'#8'ShortCut'#4'+'#160#0#0#0#1#7'Command'#7
|
||||||
|
+#18'EcToggleMarkupWord'#8'ShortCut'#4'M'#128#0#0#0#1#7'Command'#7#14'ecNorma'
|
||||||
|
+'lSelect'#8'ShortCut'#3'N`'#0#1#7'Command'#7#14'ecColumnSelect'#8'ShortCut'#3
|
||||||
|
+'C`'#0#1#7'Command'#7#12'ecLineSelect'#8'ShortCut'#3'L`'#0#1#7'Command'#7#5
|
||||||
|
+'ecTab'#8'ShortCut'#2#9#0#1#7'Command'#7#10'ecShiftTab'#8'ShortCut'#3#9' '#0
|
||||||
|
+#1#7'Command'#7#14'ecMatchBracket'#8'ShortCut'#3'B`'#0#1#7'Command'#7#10'ecC'
|
||||||
|
+'olSelUp'#8'ShortCut'#4'&'#160#0#0#0#1#7'Command'#7#12'ecColSelDown'#8'Short'
|
||||||
|
+'Cut'#4'('#160#0#0#0#1#7'Command'#7#12'ecColSelLeft'#8'ShortCut'#4'%'#160#0#0
|
||||||
|
+#0#1#7'Command'#7#13'ecColSelRight'#8'ShortCut'#4''''#160#0#0#0#1#7'Command'
|
||||||
|
+#7#16'ecColSelPageDown'#8'ShortCut'#4'"'#160#0#0#0#1#7'Command'#7#18'ecColSe'
|
||||||
|
+'lPageBottom'#8'ShortCut'#4'"'#224#0#0#0#1#7'Command'#7#14'ecColSelPageUp'#8
|
||||||
|
+'ShortCut'#4'!'#160#0#0#0#1#7'Command'#7#15'ecColSelPageTop'#8'ShortCut'#4'!'
|
||||||
|
+#224#0#0#0#1#7'Command'#7#17'ecColSelLineStart'#8'ShortCut'#4'$'#160#0#0#0#1
|
||||||
|
+#7'Command'#7#15'ecColSelLineEnd'#8'ShortCut'#4'#'#160#0#0#0#1#7'Command'#7
|
||||||
|
+#17'ecColSelEditorTop'#8'ShortCut'#4'$'#224#0#0#0#1#7'Command'#7#20'ecColSel'
|
||||||
|
+'EditorBottom'#8'ShortCut'#4'#'#224#0#0#0#0#12'MouseActions'#14#1#5'Shift'#11
|
||||||
|
+#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'ClickCount'
|
||||||
|
+#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#1#9'MoveCaret'#9#6'Optio'
|
||||||
|
+'n'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#0#9'ShiftMask'#11#7'ssShi'
|
||||||
|
+'ft'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'ClickDi'
|
||||||
|
+'r'#7#6'cdDown'#7'Command'#2#1#9'MoveCaret'#9#6'Option'#2#1#8'Priority'#2#0#0
|
||||||
|
+#1#5'Shift'#11#5'ssAlt'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6
|
||||||
|
+'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#3
|
||||||
|
+#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#5's'
|
||||||
|
+'sAlt'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'Clic'
|
||||||
|
+'kCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#3#9'MoveCaret'#9
|
||||||
|
+#6'Option'#2#1#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'
|
||||||
|
+#7#7'mbRight'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2
|
||||||
|
+#12#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMa'
|
||||||
|
+'sk'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccDouble'#8'ClickDir'#7#6
|
||||||
|
+'cdDown'#7'Command'#2#6#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'S'
|
||||||
|
+'hift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccTri'
|
||||||
|
+'ple'#8'ClickDir'#7#6'cdDown'#7'Command'#2#7#9'MoveCaret'#9#6'Option'#2#0#8
|
||||||
|
+'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10
|
||||||
|
+'ClickCount'#7#6'ccQuad'#8'ClickDir'#7#6'cdDown'#7'Command'#2#8#9'MoveCaret'
|
||||||
|
+#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Butto'
|
||||||
|
+'n'#7#8'mbMiddle'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Com'
|
||||||
|
+'mand'#2#10#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#6's'
|
||||||
|
+'sCtrl'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#6'ssCtrl'#0#6'Button'#7#6'mbLe'
|
||||||
|
+'ft'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#11#9'Mo'
|
||||||
|
+'veCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#15'MouseSelActions'#14#1#5'Shi'
|
||||||
|
+'ft'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSingl'
|
||||||
|
+'e'#8'ClickDir'#7#6'cdDown'#7'Command'#2#9#9'MoveCaret'#8#6'Option'#2#0#8'Pr'
|
||||||
|
+'iority'#2#0#0#0#13'Lines.Strings'#1#6#12'program new;'#6#5'begin'#6#4'end.'
|
||||||
|
+#0#21'BracketHighlightStyle'#7#8'sbhsBoth'#0#18'TSynGutterPartList'#0#0#15'T'
|
||||||
|
+'SynGutterMarks'#0#5'Width'#2#23#0#0#20'TSynGutterLineNumber'#0#5'Width'#2#17
|
||||||
|
+#12'MouseActions'#14#0#21'MarkupInfo.Background'#7#9'clBtnFace'#21'MarkupInf'
|
||||||
|
+'o.Foreground'#7#6'clNone'#10'DigitCount'#2#2#30'ShowOnlyLineNumbersMultiple'
|
||||||
|
+'sOf'#2#1#9'ZeroStart'#8#12'LeadingZeros'#8#0#0#17'TSynGutterChanges'#0#5'Wi'
|
||||||
|
+'dth'#2#4#13'ModifiedColor'#4#252#233#0#0#10'SavedColor'#7#7'clGreen'#0#0#19
|
||||||
|
+'TSynGutterSeparator'#0#5'Width'#2#2#0#0#21'TSynGutterCodeFolding'#0#12'Mous'
|
||||||
|
+'eActions'#14#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'#10'Cl'
|
||||||
|
+'ickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#16#9'MoveCaret'#8
|
||||||
|
+#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#7'ssShift'#0
|
||||||
|
+#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7
|
||||||
|
,'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7
|
||||||
|
+'ssShift'#0#9'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8'mbMiddle'#10'ClickCou'
|
||||||
|
+'nt'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Opt'
|
||||||
|
+'ion'#2#1#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6
|
||||||
|
+'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#0#9
|
||||||
|
+'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#21'MarkupInfo.Background'#7#6
|
||||||
|
+'clNone'#21'MarkupInfo.Foreground'#7#6'clGray'#20'MouseActionsExpanded'#14#1
|
||||||
|
+#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'cc'
|
||||||
|
+'Any'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8
|
||||||
|
+'Priority'#2#0#0#0#21'MouseActionsCollapsed'#14#1#5'Shift'#11#6'ssCtrl'#0#9
|
||||||
|
+'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8
|
||||||
|
+'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'#2#0#8'Priori'
|
||||||
|
+'ty'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'
|
||||||
|
+#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCar'
|
||||||
|
+'et'#8#6'Option'#2#1#8'Priority'#2#0#0#0#0#0#0#0#8'TSynMemo'#8'SynMemo1'#6'C'
|
||||||
|
+'ursor'#7#7'crIBeam'#4'Left'#2#20#6'Height'#2'}'#3'Top'#3#131#1#5'Width'#3
|
||||||
|
+#142#2#11'Font.Height'#2#243#9'Font.Name'#6#11'Courier New'#10'Font.Pitch'#7
|
||||||
|
+#7'fpFixed'#12'Font.Quality'#7#16'fqNonAntialiased'#11'ParentColor'#8#10'Par'
|
||||||
|
+'entFont'#8#8'TabOrder'#2#2#12'Gutter.Width'#2'9'#19'Gutter.MouseActions'#14
|
||||||
|
+#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5
|
||||||
|
+'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#13#9'MoveCaret'#8#6'Option'#2#0
|
||||||
|
+#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#7'mbRight'
|
||||||
|
+#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#12#9'MoveCa'
|
||||||
|
+'ret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#10'Keystrokes'#14#1#7'Command'#7#4
|
||||||
|
+'ecUp'#8'ShortCut'#2'&'#0#1#7'Command'#7#7'ecSelUp'#8'ShortCut'#3'& '#0#1#7
|
||||||
|
+'Command'#7#10'ecScrollUp'#8'ShortCut'#3'&@'#0#1#7'Command'#7#6'ecDown'#8'Sh'
|
||||||
|
+'ortCut'#2'('#0#1#7'Command'#7#9'ecSelDown'#8'ShortCut'#3'( '#0#1#7'Command'
|
||||||
|
+#7#12'ecScrollDown'#8'ShortCut'#3'(@'#0#1#7'Command'#7#6'ecLeft'#8'ShortCut'
|
||||||
|
+#2'%'#0#1#7'Command'#7#9'ecSelLeft'#8'ShortCut'#3'% '#0#1#7'Command'#7#10'ec'
|
||||||
|
+'WordLeft'#8'ShortCut'#3'%@'#0#1#7'Command'#7#13'ecSelWordLeft'#8'ShortCut'#3
|
||||||
|
+'%`'#0#1#7'Command'#7#7'ecRight'#8'ShortCut'#2''''#0#1#7'Command'#7#10'ecSel'
|
||||||
|
+'Right'#8'ShortCut'#3''' '#0#1#7'Command'#7#11'ecWordRight'#8'ShortCut'#3''''
|
||||||
|
+'@'#0#1#7'Command'#7#14'ecSelWordRight'#8'ShortCut'#3'''`'#0#1#7'Command'#7
|
||||||
|
+#10'ecPageDown'#8'ShortCut'#2'"'#0#1#7'Command'#7#13'ecSelPageDown'#8'ShortC'
|
||||||
|
+'ut'#3'" '#0#1#7'Command'#7#12'ecPageBottom'#8'ShortCut'#3'"@'#0#1#7'Command'
|
||||||
|
+#7#15'ecSelPageBottom'#8'ShortCut'#3'"`'#0#1#7'Command'#7#8'ecPageUp'#8'Shor'
|
||||||
|
+'tCut'#2'!'#0#1#7'Command'#7#11'ecSelPageUp'#8'ShortCut'#3'! '#0#1#7'Command'
|
||||||
|
+#7#9'ecPageTop'#8'ShortCut'#3'!@'#0#1#7'Command'#7#12'ecSelPageTop'#8'ShortC'
|
||||||
|
+'ut'#3'!`'#0#1#7'Command'#7#11'ecLineStart'#8'ShortCut'#2'$'#0#1#7'Command'#7
|
||||||
|
+#14'ecSelLineStart'#8'ShortCut'#3'$ '#0#1#7'Command'#7#11'ecEditorTop'#8'Sho'
|
||||||
|
+'rtCut'#3'$@'#0#1#7'Command'#7#14'ecSelEditorTop'#8'ShortCut'#3'$`'#0#1#7'Co'
|
||||||
|
+'mmand'#7#9'ecLineEnd'#8'ShortCut'#2'#'#0#1#7'Command'#7#12'ecSelLineEnd'#8
|
||||||
|
+'ShortCut'#3'# '#0#1#7'Command'#7#14'ecEditorBottom'#8'ShortCut'#3'#@'#0#1#7
|
||||||
|
+'Command'#7#17'ecSelEditorBottom'#8'ShortCut'#3'#`'#0#1#7'Command'#7#12'ecTo'
|
||||||
|
+'ggleMode'#8'ShortCut'#2'-'#0#1#7'Command'#7#6'ecCopy'#8'ShortCut'#3'-@'#0#1
|
||||||
|
+#7'Command'#7#7'ecPaste'#8'ShortCut'#3'- '#0#1#7'Command'#7#12'ecDeleteChar'
|
||||||
|
+#8'ShortCut'#2'.'#0#1#7'Command'#7#5'ecCut'#8'ShortCut'#3'. '#0#1#7'Command'
|
||||||
|
+#7#16'ecDeleteLastChar'#8'ShortCut'#2#8#0#1#7'Command'#7#16'ecDeleteLastChar'
|
||||||
|
+#8'ShortCut'#3#8' '#0#1#7'Command'#7#16'ecDeleteLastWord'#8'ShortCut'#3#8'@'
|
||||||
|
+#0#1#7'Command'#7#6'ecUndo'#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#7#6'ecRed'
|
||||||
|
+'o'#8'ShortCut'#4#8#160#0#0#0#1#7'Command'#7#11'ecLineBreak'#8'ShortCut'#2#13
|
||||||
|
+#0#1#7'Command'#7#11'ecSelectAll'#8'ShortCut'#3'A@'#0#1#7'Command'#7#6'ecCop'
|
||||||
|
+'y'#8'ShortCut'#3'C@'#0#1#7'Command'#7#13'ecBlockIndent'#8'ShortCut'#3'I`'#0
|
||||||
|
+#1#7'Command'#7#11'ecLineBreak'#8'ShortCut'#3'M@'#0#1#7'Command'#7#12'ecInse'
|
||||||
|
+'rtLine'#8'ShortCut'#3'N@'#0#1#7'Command'#7#12'ecDeleteWord'#8'ShortCut'#3'T'
|
||||||
|
+'@'#0#1#7'Command'#7#15'ecBlockUnindent'#8'ShortCut'#3'U`'#0#1#7'Command'#7#7
|
||||||
|
+'ecPaste'#8'ShortCut'#3'V@'#0#1#7'Command'#7#5'ecCut'#8'ShortCut'#3'X@'#0#1#7
|
||||||
|
+'Command'#7#12'ecDeleteLine'#8'ShortCut'#3'Y@'#0#1#7'Command'#7#11'ecDeleteE'
|
||||||
|
+'OL'#8'ShortCut'#3'Y`'#0#1#7'Command'#7#6'ecUndo'#8'ShortCut'#3'Z@'#0#1#7'Co'
|
||||||
|
+'mmand'#7#6'ecRedo'#8'ShortCut'#3'Z`'#0#1#7'Command'#7#13'ecGotoMarker0'#8'S'
|
||||||
|
+'hortCut'#3'0@'#0#1#7'Command'#7#13'ecGotoMarker1'#8'ShortCut'#3'1@'#0#1#7'C'
|
||||||
|
+'ommand'#7#13'ecGotoMarker2'#8'ShortCut'#3'2@'#0#1#7'Command'#7#13'ecGotoMar'
|
||||||
|
+'ker3'#8'ShortCut'#3'3@'#0#1#7'Command'#7#13'ecGotoMarker4'#8'ShortCut'#3'4@'
|
||||||
|
+#0#1#7'Command'#7#13'ecGotoMarker5'#8'ShortCut'#3'5@'#0#1#7'Command'#7#13'ec'
|
||||||
|
,'GotoMarker6'#8'ShortCut'#3'6@'#0#1#7'Command'#7#13'ecGotoMarker7'#8'ShortCu'
|
||||||
|
+'t'#3'7@'#0#1#7'Command'#7#13'ecGotoMarker8'#8'ShortCut'#3'8@'#0#1#7'Command'
|
||||||
|
+#7#13'ecGotoMarker9'#8'ShortCut'#3'9@'#0#1#7'Command'#7#12'ecSetMarker0'#8'S'
|
||||||
|
+'hortCut'#3'0`'#0#1#7'Command'#7#12'ecSetMarker1'#8'ShortCut'#3'1`'#0#1#7'Co'
|
||||||
|
+'mmand'#7#12'ecSetMarker2'#8'ShortCut'#3'2`'#0#1#7'Command'#7#12'ecSetMarker'
|
||||||
|
+'3'#8'ShortCut'#3'3`'#0#1#7'Command'#7#12'ecSetMarker4'#8'ShortCut'#3'4`'#0#1
|
||||||
|
+#7'Command'#7#12'ecSetMarker5'#8'ShortCut'#3'5`'#0#1#7'Command'#7#12'ecSetMa'
|
||||||
|
+'rker6'#8'ShortCut'#3'6`'#0#1#7'Command'#7#12'ecSetMarker7'#8'ShortCut'#3'7`'
|
||||||
|
+#0#1#7'Command'#7#12'ecSetMarker8'#8'ShortCut'#3'8`'#0#1#7'Command'#7#12'ecS'
|
||||||
|
+'etMarker9'#8'ShortCut'#3'9`'#0#1#7'Command'#7#12'EcFoldLevel1'#8'ShortCut'#4
|
||||||
|
+'1'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel2'#8'ShortCut'#4'2'#160#0#0#0#1#7
|
||||||
|
+'Command'#7#12'EcFoldLevel1'#8'ShortCut'#4'3'#160#0#0#0#1#7'Command'#7#12'Ec'
|
||||||
|
+'FoldLevel1'#8'ShortCut'#4'4'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel1'#8'Sh'
|
||||||
|
+'ortCut'#4'5'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel6'#8'ShortCut'#4'6'#160
|
||||||
|
+#0#0#0#1#7'Command'#7#12'EcFoldLevel7'#8'ShortCut'#4'7'#160#0#0#0#1#7'Comman'
|
||||||
|
+'d'#7#12'EcFoldLevel8'#8'ShortCut'#4'8'#160#0#0#0#1#7'Command'#7#12'EcFoldLe'
|
||||||
|
+'vel9'#8'ShortCut'#4'9'#160#0#0#0#1#7'Command'#7#12'EcFoldLevel0'#8'ShortCut'
|
||||||
|
+#4'0'#160#0#0#0#1#7'Command'#7#13'EcFoldCurrent'#8'ShortCut'#4'-'#160#0#0#0#1
|
||||||
|
+#7'Command'#7#15'EcUnFoldCurrent'#8'ShortCut'#4'+'#160#0#0#0#1#7'Command'#7
|
||||||
|
+#18'EcToggleMarkupWord'#8'ShortCut'#4'M'#128#0#0#0#1#7'Command'#7#14'ecNorma'
|
||||||
|
+'lSelect'#8'ShortCut'#3'N`'#0#1#7'Command'#7#14'ecColumnSelect'#8'ShortCut'#3
|
||||||
|
+'C`'#0#1#7'Command'#7#12'ecLineSelect'#8'ShortCut'#3'L`'#0#1#7'Command'#7#5
|
||||||
|
+'ecTab'#8'ShortCut'#2#9#0#1#7'Command'#7#10'ecShiftTab'#8'ShortCut'#3#9' '#0
|
||||||
|
+#1#7'Command'#7#14'ecMatchBracket'#8'ShortCut'#3'B`'#0#1#7'Command'#7#10'ecC'
|
||||||
|
+'olSelUp'#8'ShortCut'#4'&'#160#0#0#0#1#7'Command'#7#12'ecColSelDown'#8'Short'
|
||||||
|
+'Cut'#4'('#160#0#0#0#1#7'Command'#7#12'ecColSelLeft'#8'ShortCut'#4'%'#160#0#0
|
||||||
|
+#0#1#7'Command'#7#13'ecColSelRight'#8'ShortCut'#4''''#160#0#0#0#1#7'Command'
|
||||||
|
+#7#16'ecColSelPageDown'#8'ShortCut'#4'"'#160#0#0#0#1#7'Command'#7#18'ecColSe'
|
||||||
|
+'lPageBottom'#8'ShortCut'#4'"'#224#0#0#0#1#7'Command'#7#14'ecColSelPageUp'#8
|
||||||
|
+'ShortCut'#4'!'#160#0#0#0#1#7'Command'#7#15'ecColSelPageTop'#8'ShortCut'#4'!'
|
||||||
|
+#224#0#0#0#1#7'Command'#7#17'ecColSelLineStart'#8'ShortCut'#4'$'#160#0#0#0#1
|
||||||
|
+#7'Command'#7#15'ecColSelLineEnd'#8'ShortCut'#4'#'#160#0#0#0#1#7'Command'#7
|
||||||
|
+#17'ecColSelEditorTop'#8'ShortCut'#4'$'#224#0#0#0#1#7'Command'#7#20'ecColSel'
|
||||||
|
+'EditorBottom'#8'ShortCut'#4'#'#224#0#0#0#0#12'MouseActions'#14#1#5'Shift'#11
|
||||||
|
+#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'ClickCount'
|
||||||
|
+#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#1#9'MoveCaret'#9#6'Optio'
|
||||||
|
+'n'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#0#9'ShiftMask'#11#7'ssShi'
|
||||||
|
+'ft'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'ClickDi'
|
||||||
|
+'r'#7#6'cdDown'#7'Command'#2#1#9'MoveCaret'#9#6'Option'#2#1#8'Priority'#2#0#0
|
||||||
|
+#1#5'Shift'#11#5'ssAlt'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6
|
||||||
|
+'mbLeft'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#3
|
||||||
|
+#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#5's'
|
||||||
|
+'sAlt'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#0#6'Button'#7#6'mbLeft'#10'Clic'
|
||||||
|
+'kCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Command'#2#3#9'MoveCaret'#9
|
||||||
|
+#6'Option'#2#1#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'
|
||||||
|
+#7#7'mbRight'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2
|
||||||
|
+#12#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMa'
|
||||||
|
+'sk'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccDouble'#8'ClickDir'#7#6
|
||||||
|
+'cdDown'#7'Command'#2#6#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'S'
|
||||||
|
+'hift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccTri'
|
||||||
|
+'ple'#8'ClickDir'#7#6'cdDown'#7'Command'#2#7#9'MoveCaret'#9#6'Option'#2#0#8
|
||||||
|
+'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10
|
||||||
|
+'ClickCount'#7#6'ccQuad'#8'ClickDir'#7#6'cdDown'#7'Command'#2#8#9'MoveCaret'
|
||||||
|
+#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'ShiftMask'#11#0#6'Butto'
|
||||||
|
+'n'#7#8'mbMiddle'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#6'cdDown'#7'Com'
|
||||||
|
+'mand'#2#10#9'MoveCaret'#9#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#6's'
|
||||||
|
+'sCtrl'#0#9'ShiftMask'#11#7'ssShift'#5'ssAlt'#6'ssCtrl'#0#6'Button'#7#6'mbLe'
|
||||||
|
+'ft'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'#7#4'cdUp'#7'Command'#2#11#9'Mo'
|
||||||
|
+'veCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#15'MouseSelActions'#14#1#5'Shi'
|
||||||
|
+'ft'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#8'ccSingl'
|
||||||
|
+'e'#8'ClickDir'#7#6'cdDown'#7'Command'#2#9#9'MoveCaret'#8#6'Option'#2#0#8'Pr'
|
||||||
|
+'iority'#2#0#0#0#13'Lines.Strings'#1#6#8'SynMemo1'#0#8'OnChange'#7#14'SynMem'
|
||||||
|
+'o1Change'#0#18'TSynGutterPartList'#0#0#15'TSynGutterMarks'#0#5'Width'#2#23#0
|
||||||
|
+#0#20'TSynGutterLineNumber'#0#5'Width'#2#17#12'MouseActions'#14#0#21'MarkupI'
|
||||||
|
,'nfo.Background'#7#9'clBtnFace'#21'MarkupInfo.Foreground'#7#6'clNone'#10'Dig'
|
||||||
|
+'itCount'#2#2#30'ShowOnlyLineNumbersMultiplesOf'#2#1#9'ZeroStart'#8#12'Leadi'
|
||||||
|
+'ngZeros'#8#0#0#17'TSynGutterChanges'#0#5'Width'#2#4#13'ModifiedColor'#4#252
|
||||||
|
+#233#0#0#10'SavedColor'#7#7'clGreen'#0#0#19'TSynGutterSeparator'#0#5'Width'#2
|
||||||
|
+#2#0#0#21'TSynGutterCodeFolding'#0#12'MouseActions'#14#1#5'Shift'#11#0#9'Shi'
|
||||||
|
+'ftMask'#11#0#6'Button'#7#7'mbRight'#10'ClickCount'#7#8'ccSingle'#8'ClickDir'
|
||||||
|
+#7#4'cdUp'#7'Command'#2#16#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5
|
||||||
|
+'Shift'#11#0#9'ShiftMask'#11#7'ssShift'#0#6'Button'#7#8'mbMiddle'#10'ClickCo'
|
||||||
|
+'unt'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Op'
|
||||||
|
+'tion'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#7'ssShift'#0#9'ShiftMask'#11#7'ss'
|
||||||
|
+'Shift'#0#6'Button'#7#8'mbMiddle'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6
|
||||||
|
+'cdDown'#7'Command'#2#14#9'MoveCaret'#8#6'Option'#2#1#8'Priority'#2#0#0#1#5
|
||||||
|
+'Shift'#11#0#9'ShiftMask'#11#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAn'
|
||||||
|
+'y'#8'ClickDir'#7#6'cdDown'#7'Command'#2#0#9'MoveCaret'#8#6'Option'#2#0#8'Pr'
|
||||||
|
+'iority'#2#0#0#0#21'MarkupInfo.Background'#7#6'clNone'#21'MarkupInfo.Foregro'
|
||||||
|
+'und'#7#6'clGray'#20'MouseActionsExpanded'#14#1#5'Shift'#11#0#9'ShiftMask'#11
|
||||||
|
+#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7
|
||||||
|
+'Command'#2#14#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#0#21'MouseActi'
|
||||||
|
+'onsCollapsed'#14#1#5'Shift'#11#6'ssCtrl'#0#9'ShiftMask'#11#6'ssCtrl'#0#6'Bu'
|
||||||
|
+'tton'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8'ClickDir'#7#6'cdDown'#7'Comma'
|
||||||
|
+'nd'#2#15#9'MoveCaret'#8#6'Option'#2#0#8'Priority'#2#0#0#1#5'Shift'#11#0#9'S'
|
||||||
|
+'hiftMask'#11#6'ssCtrl'#0#6'Button'#7#6'mbLeft'#10'ClickCount'#7#5'ccAny'#8
|
||||||
|
+'ClickDir'#7#6'cdDown'#7'Command'#2#15#9'MoveCaret'#8#6'Option'#2#1#8'Priori'
|
||||||
|
+'ty'#2#0#0#0#0#0#0#0#17'TSynFreePascalSyn'#17'SynFreePascalSyn1'#7'Enabled'#8
|
||||||
|
+#12'CompilerMode'#7#9'pcmObjFPC'#14'NestedComments'#9#4'left'#3#242#1#3'top'
|
||||||
|
+#2'Y'#0#0#0
|
||||||
]);
|
]);
|
||||||
|
|||||||
@ -6,7 +6,8 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||||
StdCtrls, Client, MufasaTypes, mmlthread;
|
StdCtrls, SynEdit, SynHighlighterPas, SynMemo, Client, MufasaTypes,
|
||||||
|
mmlpsthread;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -14,7 +15,11 @@ type
|
|||||||
|
|
||||||
TForm1 = class(TForm)
|
TForm1 = class(TForm)
|
||||||
Button1: TButton;
|
Button1: TButton;
|
||||||
|
SynEdit1: TSynEdit;
|
||||||
|
SynFreePascalSyn1: TSynFreePascalSyn;
|
||||||
|
SynMemo1: TSynMemo;
|
||||||
procedure Button1Click(Sender: TObject);
|
procedure Button1Click(Sender: TObject);
|
||||||
|
procedure SynMemo1Change(Sender: TObject);
|
||||||
private
|
private
|
||||||
{ private declarations }
|
{ private declarations }
|
||||||
public
|
public
|
||||||
@ -254,13 +259,24 @@ end;
|
|||||||
procedure TForm1.Button1Click(Sender: TObject);
|
procedure TForm1.Button1Click(Sender: TObject);
|
||||||
Var
|
Var
|
||||||
//MyThread: TMyThread;
|
//MyThread: TMyThread;
|
||||||
MMLThread: TMMLThread;
|
// MMLThread: TMMLThread;
|
||||||
|
MMLPSThread : TMMLPSThread;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{ MyThread := TMyThread.Create(True);
|
{ MyThread := TMyThread.Create(True);
|
||||||
MyThread.Resume; }
|
MyThread.Resume; }
|
||||||
MMLThread := TMMLThread.Create(True);
|
{ MMLThread := TMMLThread.Create(True);
|
||||||
MMLThread.Resume;
|
MMLThread.Resume;}
|
||||||
|
MMLPSThread := TMMLPSThread.Create(True);
|
||||||
|
MMLPSThread.SetPSScript(SynEdit1.Lines.Text);
|
||||||
|
MMLPSThread.SetDebug(SynMemo1);
|
||||||
|
MMLPSThread.Resume;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.SynMemo1Change(Sender: TObject);
|
||||||
|
begin
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
|||||||
245
Units/MMLAddon/mmlpsthread.pas
Normal file
245
Units/MMLAddon/mmlpsthread.pas
Normal file
@ -0,0 +1,245 @@
|
|||||||
|
unit mmlpsthread;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,SynMemo;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TMMLPSThread }
|
||||||
|
|
||||||
|
TMMLPSThread = class(TThread)
|
||||||
|
protected
|
||||||
|
// PSScript : TPSScript;
|
||||||
|
// PSClient : TPSScript;
|
||||||
|
// Client: TClient;
|
||||||
|
// DebugTo : TStrings;
|
||||||
|
Client : TClient;
|
||||||
|
PSScript : TPSScript;
|
||||||
|
DebugTo : TSynMemo;
|
||||||
|
procedure OnCompile(Sender: TPSScript);
|
||||||
|
procedure AfterExecute(Sender : TPSScript);
|
||||||
|
function RequireFile(Sender: TObject; const OriginFileName: String;
|
||||||
|
var FileName, OutPut: string): Boolean;
|
||||||
|
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
|
||||||
|
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
|
||||||
|
procedure OutputMessages;
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
procedure SetPSScript(Script : string);
|
||||||
|
procedure SetDebug( Strings : TSynMemo );
|
||||||
|
function SetClientInfo : boolean;
|
||||||
|
// function CompilePSScript : boolean;
|
||||||
|
// function
|
||||||
|
constructor Create(CreateSuspended: Boolean);
|
||||||
|
destructor Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
MufasaTypes,{$ifdef mswindows}windows,{$endif}
|
||||||
|
uPSC_std, uPSC_Controls,uPSC_Classes,uPSC_Graphics,uPSC_stdctrls,uPSC_Forms,uPSC_extctrls, //Compile-libs
|
||||||
|
uPSR_std, uPSR_Controls,uPSR_Classes,uPSR_Graphics,uPSR_stdctrls,uPSR_Forms,uPSR_extctrls; //Runtime-libs
|
||||||
|
|
||||||
|
|
||||||
|
threadvar
|
||||||
|
CurrThread : TMMLPSThread;
|
||||||
|
|
||||||
|
{Some General PS Functions here}
|
||||||
|
procedure Writeln(str : string);
|
||||||
|
begin;
|
||||||
|
if CurrThread.DebugTo <> nil then
|
||||||
|
CurrThread.DebugTo.Lines.Add(Str);
|
||||||
|
//Just overwriting itz.. soz.
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
|
||||||
|
var
|
||||||
|
i : integer;
|
||||||
|
begin;
|
||||||
|
Writeln('We have a length of: ' + inttostr(length(v)));
|
||||||
|
Try
|
||||||
|
Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname));
|
||||||
|
Except
|
||||||
|
Writeln('We has some errors :-(');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
Note to Raymond: For PascalScript, Create it on the .Create,
|
||||||
|
Execute it on the .Execute, and don't forget to Destroy it on .Destroy.
|
||||||
|
|
||||||
|
Furthermore, all the wrappers can be in the unit "implementation" section.
|
||||||
|
Better still to create an .inc for it, otherwise this unit will become huge.
|
||||||
|
(You can even split up the .inc's in stuff like color, bitmap, etc. )
|
||||||
|
|
||||||
|
Also, don't add PS to this unit, but make a seperate unit for it.
|
||||||
|
Unit "MMLPSThread", perhaps?
|
||||||
|
|
||||||
|
See the TestUnit for use of this thread, it's pretty straightforward.
|
||||||
|
|
||||||
|
It may also be wise to turn the "Importing of wrappers" into an include as
|
||||||
|
well, it will really make the unit more straightforward to use and read.
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
constructor TMMLPSThread.Create(CreateSuspended : boolean);
|
||||||
|
begin
|
||||||
|
if Client <> nil then
|
||||||
|
Writeln('ThreadClient seems to be set, so not recreating it.') //reset client to defaults?
|
||||||
|
//ThreadClient.ResetToDefaults
|
||||||
|
else
|
||||||
|
Client := TClient.Create;
|
||||||
|
if PSScript <> nil then
|
||||||
|
PSScript.Free;
|
||||||
|
// Create Stuff here
|
||||||
|
PSScript := TPSScript.Create(nil);
|
||||||
|
PSScript.UsePreProcessor:= True;
|
||||||
|
PSScript.OnNeedFile := @RequireFile;
|
||||||
|
|
||||||
|
|
||||||
|
PSScript.OnCompile:= @OnCompile;
|
||||||
|
PSScript.OnCompImport:= @OnCompImport;
|
||||||
|
PSScript.OnExecImport:= @OnExecImport;
|
||||||
|
PSScript.OnAfterExecute:= @AfterExecute;
|
||||||
|
{$IFDEF CPU386 }
|
||||||
|
PSScript.Defines.Add ('CPU386');
|
||||||
|
{$ENDIF }
|
||||||
|
PSScript.Defines.Add ('MUFASA');
|
||||||
|
PSScript.Defines.Add ('COGAT');
|
||||||
|
PSScript.Defines.Add ('RAYMONDPOWNS');
|
||||||
|
{$IFDEF MSWINDOWS }
|
||||||
|
PSScript.Defines.Add ('MSWINDOWS');
|
||||||
|
PSScript.Defines.Add ('WIN32');
|
||||||
|
PSScript.Defines.Add ('WINDOWS');
|
||||||
|
{$ENDIF }
|
||||||
|
{$IFDEF LINUX }
|
||||||
|
PSScript.Defines.Add ('LINUX');
|
||||||
|
{$ENDIF }
|
||||||
|
FreeOnTerminate := True;
|
||||||
|
inherited Create(CreateSuspended);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TMMLPSThread.Destroy;
|
||||||
|
begin
|
||||||
|
Client.Free;
|
||||||
|
PSScript.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMMLPSThread.OnCompile(Sender: TPSScript);
|
||||||
|
begin
|
||||||
|
//Here we add all the initalizing, of BMPArray etc
|
||||||
|
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||||
|
Sender.AddFunction(@Writeln,'procedure writeln(s : string);');
|
||||||
|
//Also the functions get added into the engine, right here.
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMMLPSThread.AfterExecute(Sender: TPSScript);
|
||||||
|
begin
|
||||||
|
//Here we add all the Script-freeing-leftovers (like BMParray etc)
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMMLPSThread.RequireFile(Sender: TObject;
|
||||||
|
const OriginFileName: String; var FileName, OutPut: string): Boolean;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_Std(x);
|
||||||
|
SIRegister_Controls(x);
|
||||||
|
SIRegister_Classes(x, true);
|
||||||
|
SIRegister_Graphics(x, true);
|
||||||
|
SIRegister_stdctrls(x);
|
||||||
|
SIRegister_Forms(x);
|
||||||
|
SIRegister_ExtCtrls(x);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec;
|
||||||
|
x: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_Std(x);
|
||||||
|
RIRegister_Classes(x, True);
|
||||||
|
RIRegister_Controls(x);
|
||||||
|
RIRegister_Graphics(x, True);
|
||||||
|
RIRegister_stdctrls(x);
|
||||||
|
RIRegister_Forms(x);
|
||||||
|
RIRegister_ExtCtrls(x);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMMLPSThread.OutputMessages;
|
||||||
|
var
|
||||||
|
l: Longint;
|
||||||
|
b: Boolean;
|
||||||
|
begin
|
||||||
|
b := False;
|
||||||
|
for l := 0 to PSScript.CompilerMessageCount - 1 do
|
||||||
|
begin
|
||||||
|
Writeln(PSScript.CompilerErrorToStr(l));
|
||||||
|
if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then
|
||||||
|
begin
|
||||||
|
b := True;
|
||||||
|
// FormMain.CurrSynEdit.SelStart := PSScript.CompilerMessages[l].Pos;
|
||||||
|
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMMLPSThread.Execute;
|
||||||
|
var
|
||||||
|
time, i, ii: Integer;
|
||||||
|
begin;
|
||||||
|
CurrThread := Self;
|
||||||
|
time := GetTickCount;
|
||||||
|
try
|
||||||
|
if PSScript.Compile then
|
||||||
|
begin
|
||||||
|
OutputMessages;
|
||||||
|
Writeln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.');
|
||||||
|
// if not (ScriptState = SCompiling) then
|
||||||
|
if not PSScript.Execute then
|
||||||
|
begin
|
||||||
|
// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition;
|
||||||
|
Writeln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.'
|
||||||
|
+Inttostr(PSScript.ExecErrorByteCodePosition));
|
||||||
|
end else Writeln('Succesfully executed');
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
OutputMessages;
|
||||||
|
Writeln('Compiling failed');
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E : Exception do
|
||||||
|
Writeln('Error: ' + E.Message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMMLPSThread.SetPSScript(Script: string);
|
||||||
|
begin
|
||||||
|
PSScript.Script.Text:= Script;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMMLPSThread.SetDebug(Strings: TSynMemo);
|
||||||
|
begin
|
||||||
|
DebugTo := Strings;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMMLPSThread.SetClientInfo: boolean;
|
||||||
|
begin
|
||||||
|
//Set the client handle, etc
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Include stuff here? }
|
||||||
|
|
||||||
|
//{$I inc/colors.inc}
|
||||||
|
//{$I inc/bitmaps.inc}
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
@ -23,7 +23,7 @@ type
|
|||||||
TClickType = (mouse_Left, mouse_Right, mouse_Middle);
|
TClickType = (mouse_Left, mouse_Right, mouse_Middle);
|
||||||
TMousePress = (mouse_Down, mouse_Up);
|
TMousePress = (mouse_Down, mouse_Up);
|
||||||
TPointArray = array of TPoint;
|
TPointArray = array of TPoint;
|
||||||
|
TVariantArray = Array of Variant;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
|||||||
62
Units/PascalScript/PascalScript.inc
Normal file
62
Units/PascalScript/PascalScript.inc
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
{ RemObjects Pascal Script }
|
||||||
|
{ }
|
||||||
|
{ compiler: Delphi 2 and up, Kylix 3 and up }
|
||||||
|
{ platform: Win32, Linux }
|
||||||
|
{ }
|
||||||
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
||||||
|
{ }
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
|
||||||
|
{$INCLUDE eDefines.inc}
|
||||||
|
|
||||||
|
{$IFDEF FPC}{$MODE DELPHI}{$H+}{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VER125}{C4}{$B-}{$X+}{$T-}{$H+}{$ENDIF}
|
||||||
|
{$IFDEF VER110}{C3}{$B-}{$X+}{$T-}{$H+}{$ENDIF}
|
||||||
|
{$IFDEF VER93}{C1}{$B-}{$X+}{$T-}{$H+}{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
{$DEFINE PS_HAVEVARIANT}
|
||||||
|
{$DEFINE PS_DYNARRAY}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$B-}{$X+}{$T-}{$H+}
|
||||||
|
{$ELSE}
|
||||||
|
{$R-}{$Q-}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$IFNDEF DELPHI4UP}
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
{$DEFINE PS_NOINT64}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DELPHI2}
|
||||||
|
{$DEFINE PS_NOINT64}
|
||||||
|
{$DEFINE PS_NOWIDESTRING}
|
||||||
|
{$B-}{$X+}{$T-}{$H+}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}{KYLIX}{$DEFINE CLX}{$DEFINE DELPHI3UP}{$DEFINE DELPHI6UP}{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$R-}{$Q-}
|
||||||
|
|
||||||
|
|
||||||
|
{
|
||||||
|
Defines:
|
||||||
|
IFPS3_NOSMARTLIST - Don't use the smart list option
|
||||||
|
}
|
||||||
|
|
||||||
|
{$UNDEF DEBUG}
|
||||||
|
|
||||||
|
{$IFDEF CLX}
|
||||||
|
{$DEFINE PS_NOIDISPATCH} // not implemented
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$I PascalScriptFPC.inc}
|
||||||
|
{$ENDIF}
|
||||||
15
Units/PascalScript/PascalScriptFPC.inc
Normal file
15
Units/PascalScript/PascalScriptFPC.inc
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
|
||||||
|
{$DEFINE PS_HAVEVARIANT}
|
||||||
|
{$DEFINE PS_DYNARRAY}
|
||||||
|
{$DEFINE PS_NOIDISPATCH}
|
||||||
|
{$if (fpc_version=2) and (fpc_release>=3) and (fpc_patch>=1)}
|
||||||
|
{.$if (fpc_version=2) and (fpc_release>=2) and (fpc_patch>=4)}
|
||||||
|
{$UNDEF FPC_OLD_FIX}
|
||||||
|
{$UNDEF PS_FPCSTRINGWORKAROUND}
|
||||||
|
{FreePascal 2.3.1 and above has much Delphi compatibility bugs fixed}
|
||||||
|
{$else}
|
||||||
|
{$DEFINE FPC_OLD_FIX}
|
||||||
|
{$DEFINE PS_FPCSTRINGWORKAROUND}
|
||||||
|
{$ifend}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI6UP}
|
||||||
30
Units/PascalScript/PascalScript_Core_Ext_Reg.pas
Normal file
30
Units/PascalScript/PascalScript_Core_Ext_Reg.pas
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
unit PascalScript_Core_Ext_Reg;
|
||||||
|
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
{ RemObjects Pascal Script }
|
||||||
|
{ }
|
||||||
|
{ compiler: Delphi 2 and up, Kylix 3 and up }
|
||||||
|
{ platform: Win32, Linux }
|
||||||
|
{ }
|
||||||
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
||||||
|
{ }
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
uPSComponentExt;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterComponents('RemObjects Pascal Script',[TPSScriptExtension]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
65
Units/PascalScript/PascalScript_Core_Reg.pas
Normal file
65
Units/PascalScript/PascalScript_Core_Reg.pas
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
unit PascalScript_Core_Reg;
|
||||||
|
|
||||||
|
{----------------------------------------------------------------------------
|
||||||
|
/ RemObjects Pascal Script
|
||||||
|
/
|
||||||
|
/ compiler: Delphi 2 and up, Kylix 3 and up
|
||||||
|
/ platform: Win32, Linux
|
||||||
|
/
|
||||||
|
/ (c)opyright RemObjects Software. all rights reserved.
|
||||||
|
/
|
||||||
|
----------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$R PascalScript_Core_Glyphs.res}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
{$IFDEF FPC}
|
||||||
|
LResources,
|
||||||
|
{$ENDIF}
|
||||||
|
uPSComponent,
|
||||||
|
uPSDebugger,
|
||||||
|
uPSComponent_Default,
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
uPSComponent_COM,
|
||||||
|
{$ENDIF}
|
||||||
|
uPSComponent_DB,
|
||||||
|
uPSComponent_Forms,
|
||||||
|
uPSComponent_Controls,
|
||||||
|
uPSComponent_StdCtrls;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterComponents('Pascal Script', [TPSScript,
|
||||||
|
TPSScriptDebugger,
|
||||||
|
TPSDllPlugin,
|
||||||
|
TPSImport_Classes,
|
||||||
|
TPSImport_DateUtils,
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
TPSImport_ComObj,
|
||||||
|
{$ENDIF}
|
||||||
|
TPSImport_DB,
|
||||||
|
TPSImport_Forms,
|
||||||
|
TPSImport_Controls,
|
||||||
|
TPSImport_StdCtrls,
|
||||||
|
TPSCustumPlugin]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
initialization;
|
||||||
|
{$i pascalscript.lrs}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
48
Units/PascalScript/PascalScript_Core_Reg_noDB.pas
Normal file
48
Units/PascalScript/PascalScript_Core_Reg_noDB.pas
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
unit PascalScript_Core_Reg_noDB;
|
||||||
|
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
{ RemObjects Pascal Script
|
||||||
|
{
|
||||||
|
{ compiler: Delphi 2 and up, Kylix 3 and up
|
||||||
|
{ platform: Win32, Linux
|
||||||
|
{
|
||||||
|
{ (c)opyright RemObjects Software. all rights reserved.
|
||||||
|
{
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$R PascalScript_Core_Glyphs.res}
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
uPSComponent,
|
||||||
|
uPSComponentExt,
|
||||||
|
uPSDebugger,
|
||||||
|
uPSComponent_Default,
|
||||||
|
uPSComponent_COM,
|
||||||
|
uPSComponent_Forms,
|
||||||
|
uPSComponent_Controls,
|
||||||
|
uPSComponent_StdCtrls;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterComponents('Pascal Script', [TPSScript,
|
||||||
|
TPSScriptDebugger,
|
||||||
|
TPSDllPlugin,
|
||||||
|
TPSImport_Classes,
|
||||||
|
TPSImport_DateUtils,
|
||||||
|
TPSImport_ComObj,
|
||||||
|
TPSImport_Forms,
|
||||||
|
TPSImport_Controls,
|
||||||
|
TPSImport_StdCtrls,
|
||||||
|
TPSScriptExtension]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
34
Units/PascalScript/PascalScript_RO_Reg.pas
Normal file
34
Units/PascalScript/PascalScript_RO_Reg.pas
Normal file
@ -0,0 +1,34 @@
|
|||||||
|
unit PascalScript_RO_Reg;
|
||||||
|
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
{ RemObjects Pascal Script
|
||||||
|
{
|
||||||
|
{ compiler: Delphi 2 and up, Kylix 3 and up
|
||||||
|
{ platform: Win32, Linux
|
||||||
|
{
|
||||||
|
{ (c)opyright RemObjects Software. all rights reserved.
|
||||||
|
{
|
||||||
|
{ Using this code requires a valid license of Pascal Script
|
||||||
|
{ which can be obtained at http://www.remobjects.com.
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$R PascalScript_RO_Glyphs.res}
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
uROPSServerLink;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterComponents('Pascal Script', [TPSRemObjectsSdkPlugin]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
312
Units/PascalScript/arm.inc
Normal file
312
Units/PascalScript/arm.inc
Normal file
@ -0,0 +1,312 @@
|
|||||||
|
{ implementation of the arm procedure call standard for function calls in pascal script
|
||||||
|
Copyright (c) 2008 by Henry Vermaak (henry.vermaak@gmail.com)
|
||||||
|
|
||||||
|
todo: add eabi (define FPC_ABI_EABI) and wince support
|
||||||
|
|
||||||
|
notes:
|
||||||
|
|
||||||
|
most arm cpus don't allow unaligned access. by default (?) the linux kernel
|
||||||
|
is set up to try and correct unaligned access, which can lead to strange behaviour.
|
||||||
|
to turn this off, try (as root):
|
||||||
|
|
||||||
|
echo 4 > /proc/cpu/alignment
|
||||||
|
|
||||||
|
if you have an alignment problem, you will now get a crash with a backtrace like this:
|
||||||
|
(make sure you compile with -O- -gl)
|
||||||
|
|
||||||
|
An unhandled exception occurred at $0006C014 :
|
||||||
|
EBusError : Bus error or misaligned data access
|
||||||
|
$0006C014 PROCESSREPEAT, line 9670 of upscompiler.pas
|
||||||
|
$00068AAC TPSPASCALCOMPILER__PROCESSSUB, line 10459 of upscompiler.pas
|
||||||
|
$0007D0B4 TPSPASCALCOMPILER__COMPILE, line 11704 of upscompiler.pas
|
||||||
|
|
||||||
|
you can fix this by using the "unaligned" keyword around the pointer operation.
|
||||||
|
search for occurances of "unaligned" to see how this is done,
|
||||||
|
(use $ifdef FPC_REQUIRES_PROPER_ALIGNMENT).
|
||||||
|
|
||||||
|
for more information, visit:
|
||||||
|
|
||||||
|
http://www.aleph1.co.uk/oldsite/armlinux/book/afaq.html
|
||||||
|
}
|
||||||
|
|
||||||
|
const
|
||||||
|
rtINT = 0;
|
||||||
|
rtINT64 = 1;
|
||||||
|
rtFLOAT = 2;
|
||||||
|
|
||||||
|
type
|
||||||
|
Trint = array[1..4] of dword;
|
||||||
|
Trfloat = array[1..4] of double;
|
||||||
|
|
||||||
|
{$goto on}
|
||||||
|
{ define labels }
|
||||||
|
label
|
||||||
|
stack_loop,
|
||||||
|
load_regs,
|
||||||
|
asmcall_end,
|
||||||
|
int_result,
|
||||||
|
int64_result,
|
||||||
|
float_result;
|
||||||
|
|
||||||
|
{ call a function from a pointer }
|
||||||
|
{ resulttype: 0 = int, 1 = int64, 2 = float }
|
||||||
|
function armasmcall(rint: Trint; rfloat: Trfloat; proc, stack: pointer; stacksize, resulttype: integer): pointer; assembler; nostackframe;
|
||||||
|
asm
|
||||||
|
mov r12, r13
|
||||||
|
stmfd r13!, {r4, r5, r6, r7, r8, r9, r10, r11, r12, r14, r15}
|
||||||
|
sub r11, r12, #4
|
||||||
|
mov r4, #80 (* space for preserved registers and parameters *)
|
||||||
|
ldr r5, [r11, #4] (* stacksize we need for subroutine *)
|
||||||
|
add r4, r4, r5
|
||||||
|
sub r13, r13, r4 (* create stack space *)
|
||||||
|
|
||||||
|
(* store parameters on stack *)
|
||||||
|
str r0, [r11, #-44] (* rint *)
|
||||||
|
str r1, [r11, #-48] (* rfloat *)
|
||||||
|
str r2, [r11, #-52] (* proc *)
|
||||||
|
str r3, [r11, #-56] (* stack *)
|
||||||
|
ldr r0, [r11, #4]
|
||||||
|
str r0, [r11, #-60] (* stacksize *)
|
||||||
|
ldr r0, [r11, #8]
|
||||||
|
str r0, [r11, #-64] (* resulttype *)
|
||||||
|
|
||||||
|
(* store params for sub-routine that don't fit into r0-r3 at start of stack *)
|
||||||
|
ldr r0, [r11, #-60] (* stacksize *)
|
||||||
|
cmp r0, #0
|
||||||
|
beq load_regs (* skip if no stack *)
|
||||||
|
mov r1, r13 (* this points to the bottom now *)
|
||||||
|
ldr r2, [r11, #-56] (* stack pointer *)
|
||||||
|
stack_loop:
|
||||||
|
ldmia r2!, {r4} (* get stack + update pos *)
|
||||||
|
stmia r1!, {r4} (* store stack + update pos *)
|
||||||
|
subs r0, r0, #4
|
||||||
|
bne stack_loop
|
||||||
|
|
||||||
|
load_regs:
|
||||||
|
(* load general regs *)
|
||||||
|
ldr r4, [r11, #-44] (* rint *)
|
||||||
|
ldr r0, [r4]
|
||||||
|
ldr r1, [r4, #4]
|
||||||
|
ldr r2, [r4, #8]
|
||||||
|
ldr r3, [r4, #12]
|
||||||
|
|
||||||
|
{$ifdef FPUFPA}
|
||||||
|
(* load float regs *)
|
||||||
|
ldr r4, [r11, #-48] (* rfloat *)
|
||||||
|
ldfd f0, [r4]
|
||||||
|
ldfd f1, [r4, #8]
|
||||||
|
ldfd f2, [r4, #16]
|
||||||
|
ldfd f3, [r4, #24]
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
(* branch to the proc pointer *)
|
||||||
|
ldr r4, [r11, #-52]
|
||||||
|
mov r14, r15
|
||||||
|
mov r15, r4
|
||||||
|
(* blx r4 *)
|
||||||
|
|
||||||
|
ldr r4, [r11, #-64] (* get resulttype *)
|
||||||
|
cmp r4, #1
|
||||||
|
blt int_result
|
||||||
|
beq int64_result
|
||||||
|
bgt float_result
|
||||||
|
|
||||||
|
int_result:
|
||||||
|
str r0, [r11, #-72]
|
||||||
|
b asmcall_end
|
||||||
|
|
||||||
|
int64_result:
|
||||||
|
str r0, [r11, #-72]
|
||||||
|
str r1, [r11, #-68]
|
||||||
|
b asmcall_end
|
||||||
|
|
||||||
|
float_result:
|
||||||
|
{$ifdef FPUFPA}
|
||||||
|
stfd f0, [r11, #-72]
|
||||||
|
{$else}
|
||||||
|
b int64_result
|
||||||
|
{$endif}
|
||||||
|
b asmcall_end
|
||||||
|
|
||||||
|
asmcall_end:
|
||||||
|
sub r0, r11, #72 (* return pointer to result on stack *)
|
||||||
|
|
||||||
|
ldmea r11,{r4,r5,r6,r7,r8,r9,r10,r11,r13,r15}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
|
||||||
|
var
|
||||||
|
rint: Trint; { registers r0 to r3 }
|
||||||
|
rfloat: Trfloat; { registers f0 to f3 }
|
||||||
|
st: packed array of byte; { stack }
|
||||||
|
i, j, rindex, findex, stindex: integer;
|
||||||
|
fvar: PPSVariantIFC;
|
||||||
|
IsConstructor: Boolean;
|
||||||
|
|
||||||
|
{ add a dword to stack }
|
||||||
|
procedure addstackdword(value: dword);
|
||||||
|
begin
|
||||||
|
setlength(st, stindex+4);
|
||||||
|
pdword(@st[stindex])^ := value;
|
||||||
|
inc(stindex, 4);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ add a float to stack }
|
||||||
|
procedure addstackfloat(value: pointer; size: integer);
|
||||||
|
begin
|
||||||
|
setlength(st, stindex + (size * 4));
|
||||||
|
if size = 1
|
||||||
|
then psingle(@st[stindex])^ := single(value^)
|
||||||
|
else pdouble(@st[stindex])^ := double(value^);
|
||||||
|
inc(stindex, size*4);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ add to the general registers or overflow to stack }
|
||||||
|
procedure addgen(value: dword);
|
||||||
|
begin
|
||||||
|
if rindex <= 4
|
||||||
|
then begin
|
||||||
|
rint[rindex] := value;
|
||||||
|
inc(rindex);
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
addstackdword(value);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ add to the float registers or overflow to stack }
|
||||||
|
{ size = 1 for single, 2 for double }
|
||||||
|
procedure addfloat(value: pointer; size: integer);
|
||||||
|
begin
|
||||||
|
if findex <= 4
|
||||||
|
then begin
|
||||||
|
if size = 1
|
||||||
|
then rfloat[findex] := single(value^)
|
||||||
|
else rfloat[findex] := double(value^);
|
||||||
|
inc(findex);
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
addstackfloat(value, size);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if (Integer(CallingConv) and 64) <> 0 then begin
|
||||||
|
IsConstructor := true;
|
||||||
|
CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 64);
|
||||||
|
end else IsConstructor := false;
|
||||||
|
|
||||||
|
rindex := 1;
|
||||||
|
findex := 1;
|
||||||
|
stindex := 0;
|
||||||
|
setlength(st, stindex);
|
||||||
|
Result := False;
|
||||||
|
|
||||||
|
{ the pointer of the result needs to be passed first in the case of some result types }
|
||||||
|
if assigned(res)
|
||||||
|
then begin
|
||||||
|
case res.atype.basetype of
|
||||||
|
btStaticArray, btRecord: addgen(dword(res.dta));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ process all parameters }
|
||||||
|
for i := 0 to Params.Count-1 do begin
|
||||||
|
if Params[i] = nil
|
||||||
|
then Exit;
|
||||||
|
fvar := Params[i];
|
||||||
|
|
||||||
|
{ cook dynamic arrays - fpc stores size-1 at @array-4 }
|
||||||
|
if (fvar.aType.BaseType = btArray)
|
||||||
|
then dec(pdword(pointer(fvar.dta^)-4)^);
|
||||||
|
|
||||||
|
if fvar.varparam
|
||||||
|
then begin { var param }
|
||||||
|
case fvar.aType.BaseType of
|
||||||
|
{ add var params here }
|
||||||
|
btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF}
|
||||||
|
btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
|
||||||
|
{$IFNDEF PS_NOINT64}, bts64{$ENDIF}: addgen(dword(fvar.dta));
|
||||||
|
else begin
|
||||||
|
writeln(stderr, 'Parameter type not recognised!');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end; { case }
|
||||||
|
end else begin { not a var param }
|
||||||
|
case fvar.aType.BaseType of
|
||||||
|
// btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF}
|
||||||
|
// btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
|
||||||
|
// {$IFNDEF PS_NOINT64}, bts64{$ENDIF}: writeln('normal param');
|
||||||
|
|
||||||
|
{ add normal params here }
|
||||||
|
btString: addgen(dword(pstring(fvar.dta)^));
|
||||||
|
btU8, btS8: addgen(dword(pbyte(fvar.dta)^));
|
||||||
|
btU16, BtS16: addgen(dword(pword(fvar.dta)^));
|
||||||
|
btU32, btS32: addgen(dword(pdword(fvar.dta)^));
|
||||||
|
btSingle: {$ifdef FPUFPA}
|
||||||
|
addfloat(fvar.dta, 1);
|
||||||
|
{$else}
|
||||||
|
addgen(dword(psingle(fvar.dta)^));
|
||||||
|
{$endif}
|
||||||
|
btDouble{, btExtended}: {$ifdef FPUFPA}
|
||||||
|
addfloat(fvar.dta, 2);
|
||||||
|
{$else}
|
||||||
|
begin
|
||||||
|
addgen(lo(qword(pdouble(fvar.dta)^)));
|
||||||
|
addgen(hi(qword(pdouble(fvar.dta)^)));
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
btPChar: addgen(dword(ppchar(fvar.dta)^));
|
||||||
|
btChar: addgen(dword(pchar(fvar.dta)^));
|
||||||
|
{$IFNDEF PS_NOINT64}bts64:{$ENDIF} begin
|
||||||
|
addgen(dword(pint64(fvar.dta)^ and $ffffffff));
|
||||||
|
addgen(dword(pint64(fvar.dta)^ shr 32));
|
||||||
|
end;
|
||||||
|
btStaticArray: addgen(dword(fvar.dta));
|
||||||
|
btRecord: for j := 0 to (fvar.atype.realsize div 4)-1 do
|
||||||
|
addgen(pdword(fvar.dta + j*4)^);
|
||||||
|
btArray: addstackdword(dword(fvar.dta^)); { this is a bit weird }
|
||||||
|
|
||||||
|
{ btVariant, btSet, btInterface, btClass }
|
||||||
|
|
||||||
|
else begin
|
||||||
|
writeln(stderr, 'Parameter type not implemented!');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end; { case }
|
||||||
|
end; { else }
|
||||||
|
end; { for }
|
||||||
|
|
||||||
|
if not assigned(res)
|
||||||
|
then begin
|
||||||
|
armasmcall(rint, rfloat, address, st, stindex, rtINT); { ignore return }
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
case res.atype.basetype of
|
||||||
|
{ add result types here }
|
||||||
|
btString: pstring(res.dta)^ := pstring(armasmcall(rint, rfloat, address, st, stindex, rtINT))^;
|
||||||
|
btU8, btS8: pbyte(res.dta)^ := byte(pdword(armasmcall(rint, rfloat, address, st, stindex, rtINT))^);
|
||||||
|
btU16, btS16: pword(res.dta)^ := word(pdword(armasmcall(rint, rfloat, address, st, stindex, rtINT))^);
|
||||||
|
btU32, btS32: pdword(res.dta)^ := pdword(armasmcall(rint, rfloat, address, st, stindex, rtINT))^;
|
||||||
|
btSingle: psingle(res.dta)^ := pdouble(armasmcall(rint, rfloat, address, st, stindex, rtFLOAT))^;
|
||||||
|
btDouble{, btExtended}: pdouble(res.dta)^ := pdouble(armasmcall(rint, rfloat, address, st, stindex, rtFLOAT))^;
|
||||||
|
btPChar: ppchar(res.dta)^ := pchar(pdword(armasmcall(rint, rfloat, address, st, stindex, rtINT))^);
|
||||||
|
btChar: pchar(res.dta)^ := char(pdword(armasmcall(rint, rfloat, address, st, stindex, rtINT))^);
|
||||||
|
btStaticArray, btRecord: armasmcall(rint, rfloat, address, st, stindex, rtINT);
|
||||||
|
btArray: res.dta := armasmcall(rint, rfloat, address, st, stindex, rtINT);
|
||||||
|
|
||||||
|
else begin
|
||||||
|
writeln(stderr, 'Result type not implemented!');
|
||||||
|
exit;
|
||||||
|
end; { else }
|
||||||
|
end; { case }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ cook dynamic arrays - fpc stores size-1 at @array-4 }
|
||||||
|
for i := 0 to Params.Count-1 do begin
|
||||||
|
fvar := Params[i];
|
||||||
|
if (fvar.aType.BaseType = btArray)
|
||||||
|
then inc(pdword(pointer(fvar.dta^)-4)^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
493
Units/PascalScript/eDefines.inc
Normal file
493
Units/PascalScript/eDefines.inc
Normal file
@ -0,0 +1,493 @@
|
|||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
{file: eDefines.inc }
|
||||||
|
{type: Delphi include file }
|
||||||
|
{ }
|
||||||
|
{compiler: Borland Pascal 7, }
|
||||||
|
{ Delphi 1-7, 2005-2007 for Win32 }
|
||||||
|
{ Kylix 1-3, }
|
||||||
|
{ C++Builder 1-6, 2006-2007 }
|
||||||
|
{ Free Pascal Compiler 2.x }
|
||||||
|
{ }
|
||||||
|
{platforms: DOS, DPMI, Win16, Win32, Win64, Linux, Mac OS X }
|
||||||
|
{ }
|
||||||
|
{author: mh@elitedev.com }
|
||||||
|
{ }
|
||||||
|
{contents: Defines that can be flexibily used to determine the exact }
|
||||||
|
{ compiler version used. }
|
||||||
|
{ }
|
||||||
|
{(c)opyright elitedevelopments software. all rights reserved. }
|
||||||
|
{ http://www.elitedev.com }
|
||||||
|
{ }
|
||||||
|
{ Third Party component developers are encouraged to use the set of defines }
|
||||||
|
{ established in this file, rather then their own system, for checking their }
|
||||||
|
{ component libraries agains different versions of Delphi and C++Builder. }
|
||||||
|
{ }
|
||||||
|
{ This file may be distributed freely with both free and commercial source }
|
||||||
|
{ libraries, but you are asked to please leave this comment in place, and }
|
||||||
|
{ to return any improvements you make to this file to the maintainer that }
|
||||||
|
{ is noted above. }
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
{ Compiler and OS version defines: }
|
||||||
|
{ }
|
||||||
|
{ exact compiler versions: }
|
||||||
|
{ }
|
||||||
|
{ BP7 Borland Pascal 7.0 }
|
||||||
|
{ DELPHI1 Delphi 1.0 (any Delphi) }
|
||||||
|
{ DELPHI2 Delphi 2.0 }
|
||||||
|
{ DELPHI3 Delphi 3.0 }
|
||||||
|
{ DELPHI4 Delphi 4.0 }
|
||||||
|
{ DELPHI5 Delphi 5.0 }
|
||||||
|
{ DELPHI6 Delphi 6.0 }
|
||||||
|
{ DELPHI7 Delphi 7.0 }
|
||||||
|
{ DELPHI9 Delphi 2005 }
|
||||||
|
{ DELPHI2005 Delphi 2005 }
|
||||||
|
{ DELPHI2006 Delphi 2006 }
|
||||||
|
{ DELPHI2007 Delphi 2007 }
|
||||||
|
{ KYLIX1 Kylix 1.0 }
|
||||||
|
{ KYLIX2 Kylix 2.0 }
|
||||||
|
{ KYLIX3 Kylix 3.0 }
|
||||||
|
{ CBUILDER1 C++Builder 1.0 }
|
||||||
|
{ CBUILDER3 C++Builder 3.0 }
|
||||||
|
{ CBUILDER4 C++Builder 4.0 }
|
||||||
|
{ CBUILDER5 C++Builder 5.0 }
|
||||||
|
{ }
|
||||||
|
{ }
|
||||||
|
{ minimum compiler versions: }
|
||||||
|
{ }
|
||||||
|
{ DELPHI1UP Delphi 1.0 and above (any Delphi) }
|
||||||
|
{ DELPHI2UP Delphi 2.0 and above }
|
||||||
|
{ DELPHI3UP Delphi 3.0 and above }
|
||||||
|
{ DELPHI4UP Delphi 4.0 and above }
|
||||||
|
{ DELPHI5UP Delphi 5.0 and above }
|
||||||
|
{ DELPHI6UP Delphi 6.0 and above }
|
||||||
|
{ DELPHI7UP Delphi 7.0 and above }
|
||||||
|
{ DELPHI9UP Delphi 9.0 (2005) and above }
|
||||||
|
{ DELPHI10UP Delphi 10.0 (2006) and above }
|
||||||
|
{ DELPHI11UP Delphi 11.0 (2007) and above }
|
||||||
|
{ DELPHI2005UP Delphi 2005 and above }
|
||||||
|
{ DELPHI2006UP Delphi 2006 and above }
|
||||||
|
{ DELPHI2007UP Delphi 2007 and above }
|
||||||
|
{ KYLIX1UP Kylix 1.0 and above (any Kylix) }
|
||||||
|
{ KYLIX2UP Kylix 2.0 and above (any Kylix) }
|
||||||
|
{ KYLIX3UP Kylix 3.0 and above (any Kylix) }
|
||||||
|
{ CBUILDER1UP C++Builder 1.0 and above or Delphi 2 and above }
|
||||||
|
{ CBUILDER3UP C++Builder 3.0 and above or Delphi 3.0 and above }
|
||||||
|
{ CBUILDER4UP C++Builder 4.0 and above or Delphi 4.0 and above }
|
||||||
|
{ CBUILDER5UP C++Builder 5.0 and above or Delphi 5.0 and above }
|
||||||
|
{ CBUILDER6UP C++Builder 5.0 and above or Delphi 5.0 and above }
|
||||||
|
{ }
|
||||||
|
{ }
|
||||||
|
{ compiler types: }
|
||||||
|
{ }
|
||||||
|
{ BP Borland Pascal (not Delphi or C++Builder) }
|
||||||
|
{ DELPHI any Delphi version (but not C++Builder or Kylix) }
|
||||||
|
{ KYLIX any Kylix version (not Delphi or C++Builder for Windows) }
|
||||||
|
{ CBUILDER any C++Builder for Windows (Pascal) }
|
||||||
|
{ }
|
||||||
|
{ }
|
||||||
|
{ target platforms compiler types: }
|
||||||
|
{ }
|
||||||
|
{ DELPHI_16BIT 16bit Delphi (but not C++Builder!) }
|
||||||
|
{ DELPHI_32BIT 32bit Delphi (but not C++Builder) }
|
||||||
|
{ KYLIX_32BIT 32bit Kylix (but not C++Builder) }
|
||||||
|
{ CBUILDER_32BIT 32bit C++Builer's Pascal (but not Delphi) }
|
||||||
|
{ }
|
||||||
|
{ }
|
||||||
|
{ target cpu types }
|
||||||
|
{ }
|
||||||
|
{ CPU16 16bit Delphi or Borland Pascal }
|
||||||
|
{ CPU32 32bit Delphi or Free Pascal }
|
||||||
|
{ CPU64 64bit Free Pascal }
|
||||||
|
{ }
|
||||||
|
{ target platforms }
|
||||||
|
{ }
|
||||||
|
{ DOS any DOS (plain and DPMI) }
|
||||||
|
{ REALMODE 16bit realmode DOS }
|
||||||
|
{ PROTECTEDMODE 16bit DPMI DOS }
|
||||||
|
{ }
|
||||||
|
{ MSWINDOWS any Windows platform }
|
||||||
|
{ WIN16 16bit Windows }
|
||||||
|
{ WIN32 32bit Windows }
|
||||||
|
{ WIN64 64bit Windows }
|
||||||
|
{ DOTNET .NET }
|
||||||
|
{ }
|
||||||
|
{ LINUX any Linux platform }
|
||||||
|
{ LINUX32 32bit Linux }
|
||||||
|
{ LINUX64 64bit Linux }
|
||||||
|
{ }
|
||||||
|
{ DARWIN Any Mac OS X }
|
||||||
|
{ DARWIN32 32bit Mac OS X }
|
||||||
|
{ DARWIN64 64bit Mac OS X }
|
||||||
|
{----------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
{ defines for Borland Pascal 7.0 }
|
||||||
|
{$IFDEF VER70}
|
||||||
|
{$DEFINE BP}
|
||||||
|
{$DEFINE BP7}
|
||||||
|
{$DEFINE 16BIT}
|
||||||
|
{$DEFINE CPU16}
|
||||||
|
|
||||||
|
{ defines for BP7 DOS real mode }
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
{$DEFINE DOS}
|
||||||
|
{$DEFINE REALMODE}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for BP7 DOS protected mode }
|
||||||
|
{$IFDEF DPMI}
|
||||||
|
{$DEFINE DOS}
|
||||||
|
{$DEFINE PROTECTEDMODE}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for BP7 Windows }
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
{$DEFINE MSWINDOWS}
|
||||||
|
{$DEFINE WIN16}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 1.0 thru 7.0 }
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
|
||||||
|
{ defines for Delphi 1.0 }
|
||||||
|
{$IFDEF VER80}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI1}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI_16BIT}
|
||||||
|
{$DEFINE WIN16}
|
||||||
|
{$DEFINE 16BIT}
|
||||||
|
{$DEFINE CPU16}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 2.0 }
|
||||||
|
{$IFDEF VER90}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI2}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for C++Builder 1.0 }
|
||||||
|
{$IFDEF VER93}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE CBUILDER}
|
||||||
|
{$DEFINE CBUILDER1}
|
||||||
|
{$DEFINE CBUILDER1UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 3.0 }
|
||||||
|
{$IFDEF VER100}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI3}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for C++Builder 3.0 }
|
||||||
|
{$IFDEF VER110}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE CBUILDER}
|
||||||
|
{$DEFINE CBUILDER3}
|
||||||
|
{$DEFINE CBUILDER1UP}
|
||||||
|
{$DEFINE CBUILDER3UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 4.0 }
|
||||||
|
{$IFDEF VER120}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI4}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for C++Builder 4.0 }
|
||||||
|
{$IFDEF VER125}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE CBUILDER}
|
||||||
|
{$DEFINE CBUILDER4}
|
||||||
|
{$DEFINE CBUILDER1UP}
|
||||||
|
{$DEFINE CBUILDER3UP}
|
||||||
|
{$DEFINE CBUILDER4UP}
|
||||||
|
{$ENDIF}
|
||||||
|
{ defines for Delphi 5.0 }
|
||||||
|
{$IFDEF VER130}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI5}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE DELPHI5UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for C++Builder 5.0 }
|
||||||
|
{$IFDEF VER135}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE DELPHI5UP}
|
||||||
|
{$DEFINE CBUILDER}
|
||||||
|
{$DEFINE CBUILDER5}
|
||||||
|
{$DEFINE CBUILDER1UP}
|
||||||
|
{$DEFINE CBUILDER3UP}
|
||||||
|
{$DEFINE CBUILDER4UP}
|
||||||
|
{$DEFINE CBUILDER5UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 6.0 }
|
||||||
|
{$IFDEF VER140}
|
||||||
|
{$DEFINE VER140UP}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI6}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE DELPHI5UP}
|
||||||
|
{$DEFINE DELPHI6UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 7.0 }
|
||||||
|
{$IFDEF VER150}
|
||||||
|
{$DEFINE VER140UP}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI7}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE DELPHI5UP}
|
||||||
|
{$DEFINE DELPHI6UP}
|
||||||
|
{$DEFINE DELPHI7UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 2005 }
|
||||||
|
{$IFDEF VER170}
|
||||||
|
{$DEFINE VER140UP}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI9}
|
||||||
|
{$DEFINE DELPHI2005}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE DELPHI5UP}
|
||||||
|
{$DEFINE DELPHI6UP}
|
||||||
|
{$DEFINE DELPHI7UP}
|
||||||
|
{$DEFINE DELPHI9UP}
|
||||||
|
{$DEFINE DELPHI2005UP}
|
||||||
|
{$DEFINE BDS}
|
||||||
|
{$DEFINE BDS3}
|
||||||
|
{$DEFINE BDS3UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 2006 }
|
||||||
|
{$IFDEF VER180}
|
||||||
|
{$DEFINE VER140UP}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
{$DEFINE DELPHI10}
|
||||||
|
{$DEFINE DELPHI10A}
|
||||||
|
{$DEFINE DELPHI2006}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE DELPHI5UP}
|
||||||
|
{$DEFINE DELPHI6UP}
|
||||||
|
{$DEFINE DELPHI7UP}
|
||||||
|
{$DEFINE DELPHI9UP}
|
||||||
|
{$DEFINE DELPHI10UP}
|
||||||
|
{$DEFINE DELPHI2005UP}
|
||||||
|
{$DEFINE DELPHI2006UP}
|
||||||
|
{$DEFINE BDS}
|
||||||
|
{$DEFINE BDS4}
|
||||||
|
{$DEFINE BDS3UP}
|
||||||
|
{$DEFINE BDS4UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 2007 }
|
||||||
|
{$IFDEF VER185}
|
||||||
|
{$UNDEF DELPHI10A} // declared in VER180
|
||||||
|
{$UNDEF DELPHI2006} // declared in VER180
|
||||||
|
{$UNDEF BDS4} // declared in VER180
|
||||||
|
|
||||||
|
{$DEFINE DELPHI10B}
|
||||||
|
{$DEFINE DELPHI10BUP}
|
||||||
|
{$DEFINE DELPHI11}
|
||||||
|
{$DEFINE DELPHI11UP}
|
||||||
|
{$DEFINE DELPHI2007}
|
||||||
|
{$DEFINE DELPHI2007UP}
|
||||||
|
{$DEFINE BDS5}
|
||||||
|
{$DEFINE BDS5UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 2009 }
|
||||||
|
{$IFDEF VER200}
|
||||||
|
{$DEFINE VER140UP}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
|
||||||
|
{$DEFINE DELPHI12}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE DELPHI5UP}
|
||||||
|
{$DEFINE DELPHI6UP}
|
||||||
|
{$DEFINE DELPHI7UP}
|
||||||
|
{$DEFINE DELPHI9UP}
|
||||||
|
{$DEFINE DELPHI10UP}
|
||||||
|
{$DEFINE DELPHI11UP}
|
||||||
|
{$DEFINE DELPHI12UP}
|
||||||
|
|
||||||
|
{$DEFINE DELPHI2009}
|
||||||
|
{$DEFINE DELPHI2005UP}
|
||||||
|
{$DEFINE DELPHI2006UP}
|
||||||
|
{$DEFINE DELPHI2007UP}
|
||||||
|
{$DEFINE DELPHI2009UP}
|
||||||
|
|
||||||
|
{$DEFINE BDS}
|
||||||
|
{$DEFINE BDS6}
|
||||||
|
{$DEFINE BDS3UP}
|
||||||
|
{$DEFINE BDS4UP}
|
||||||
|
{$DEFINE BDS5UP}
|
||||||
|
{$DEFINE BDS6UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ defines for Delphi 2010 }
|
||||||
|
{$IFDEF VER210}
|
||||||
|
{$DEFINE VER140UP}
|
||||||
|
{$DEFINE DELPHI}
|
||||||
|
|
||||||
|
{$DEFINE DELPHI14}
|
||||||
|
{$DEFINE DELPHI1UP}
|
||||||
|
{$DEFINE DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI3UP}
|
||||||
|
{$DEFINE DELPHI4UP}
|
||||||
|
{$DEFINE DELPHI5UP}
|
||||||
|
{$DEFINE DELPHI6UP}
|
||||||
|
{$DEFINE DELPHI7UP}
|
||||||
|
{$DEFINE DELPHI9UP}
|
||||||
|
{$DEFINE DELPHI10UP}
|
||||||
|
{$DEFINE DELPHI11UP}
|
||||||
|
{$DEFINE DELPHI12UP}
|
||||||
|
{$DEFINE DELPHI14UP}
|
||||||
|
|
||||||
|
{$DEFINE DELPHI2010}
|
||||||
|
{$DEFINE DELPHI2005UP}
|
||||||
|
{$DEFINE DELPHI2006UP}
|
||||||
|
{$DEFINE DELPHI2007UP}
|
||||||
|
{$DEFINE DELPHI2009UP}
|
||||||
|
{$DEFINE DELPHI2010UP}
|
||||||
|
|
||||||
|
{$DEFINE BDS}
|
||||||
|
{$DEFINE BDS7}
|
||||||
|
{$DEFINE BDS3UP}
|
||||||
|
{$DEFINE BDS4UP}
|
||||||
|
{$DEFINE BDS5UP}
|
||||||
|
{$DEFINE BDS6UP}
|
||||||
|
{$DEFINE BDS7UP}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$DEFINE MSWINDOWS} //not automatically defined for Delphi 2 thru 5
|
||||||
|
{$DEFINE 32BIT}
|
||||||
|
{$DEFINE CPU32}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$ENDIF MSWINDOWS}
|
||||||
|
|
||||||
|
{ defines for "Delphi for .NET" }
|
||||||
|
{$IFDEF CLR}
|
||||||
|
{$DEFINE DOTNET}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DELPHI}
|
||||||
|
{$IFDEF DELPHI2UP}
|
||||||
|
{$DEFINE DELPHI_32BIT}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF CBUILDER}
|
||||||
|
{$DEFINE CBUILDER_32BIT}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
|
||||||
|
{ Kylix 1.0 thru 3.0 }
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
|
||||||
|
{$DEFINE VER140UP}
|
||||||
|
|
||||||
|
{ Any Kylix }
|
||||||
|
{$DEFINE 32BIT}
|
||||||
|
{$DEFINE LINUX32}
|
||||||
|
{$DEFINE KYLIX_32BIT}
|
||||||
|
{$DEFINE KYLIX}
|
||||||
|
{$DEFINE KYLIX1UP}
|
||||||
|
|
||||||
|
{$IFDEF CONDITIONALEXPRESSIONS}
|
||||||
|
{$IF Declared(CompilerVersion)}
|
||||||
|
|
||||||
|
{ Kylix 2.0 }
|
||||||
|
{$IF Declared(RTLVersion) and (RTLVersion = 14.1)}
|
||||||
|
{$DEFINE KYLIX2}
|
||||||
|
{$DEFINE KYLIX1UP}
|
||||||
|
{$DEFINE KYLIX2UP}
|
||||||
|
{$IFEND}
|
||||||
|
|
||||||
|
{ Kylix 3.0 - Delphi portion }
|
||||||
|
{$IF Declared(RTLVersion) and (RTLVersion = 14.5)}
|
||||||
|
{$DEFINE KYLIX3}
|
||||||
|
{$DEFINE KYLIX1UP}
|
||||||
|
{$DEFINE KYLIX2UP}
|
||||||
|
{$DEFINE KYLIX3UP}
|
||||||
|
{$IFEND}
|
||||||
|
|
||||||
|
{ Kylix 1.0 }
|
||||||
|
{$ELSE}
|
||||||
|
{$DEFINE KYLIX1}
|
||||||
|
{$IFEND}
|
||||||
|
{$ENDIF CONDITIONALEXPRESSIONS}
|
||||||
|
|
||||||
|
{$ENDIF LINUX}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ CPU }
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
{$IFDEF CPU64}
|
||||||
|
{$DEFINE WIN64}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
{$IFDEF CPU32}
|
||||||
|
{$DEFINE LINUX32}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF CPU64}
|
||||||
|
{$DEFINE LINUX64}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
{$IFDEF CPU32}
|
||||||
|
{$DEFINE DARWIN32}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF CPU64}
|
||||||
|
{$DEFINE DARWIN64}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
29
Units/PascalScript/pascalscript.pas
Normal file
29
Units/PascalScript/pascalscript.pas
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
{ This file was automatically created by Lazarus. Do not edit!
|
||||||
|
This source is only used to compile and install the package.
|
||||||
|
}
|
||||||
|
|
||||||
|
unit PascalScript;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
uPSRuntime, PascalScript_Core_Reg, uPSC_buttons, uPSC_classes, uPSC_controls,
|
||||||
|
uPSC_dateutils, uPSC_DB, uPSC_dll, uPSC_extctrls, uPSC_forms,
|
||||||
|
uPSC_graphics, uPSC_menus, uPSC_std, uPSC_stdctrls, uPSCompiler,
|
||||||
|
uPSComponent, uPSComponent_Controls, uPSComponent_DB, uPSComponent_Default,
|
||||||
|
uPSComponent_Forms, uPSComponent_StdCtrls, uPSComponentExt, uPSDebugger,
|
||||||
|
uPSDisassembly, uPSPreProcessor, uPSR_buttons, uPSR_classes, uPSR_controls,
|
||||||
|
uPSR_dateutils, uPSR_DB, uPSR_dll, uPSR_extctrls, uPSR_forms,
|
||||||
|
uPSR_graphics, uPSR_menus, uPSR_std, uPSR_stdctrls, uPSUtils,
|
||||||
|
LazarusPackageIntf;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterUnit('PascalScript_Core_Reg', @PascalScript_Core_Reg.Register);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterPackage('PascalScript', @Register);
|
||||||
|
end.
|
||||||
343
Units/PascalScript/powerpc.inc
Normal file
343
Units/PascalScript/powerpc.inc
Normal file
@ -0,0 +1,343 @@
|
|||||||
|
{ implementation of the powerpc osx abi for function calls in pascal script
|
||||||
|
Copyright (c) 2007 by Henry Vermaak (henry.vermaak@gmail.com) }
|
||||||
|
|
||||||
|
{$ifndef darwin}
|
||||||
|
{$fatal This code is Darwin specific at the moment!}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifndef cpu32}
|
||||||
|
{$fatal This code is 32bit specific at the moment!}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
const
|
||||||
|
rtINT = 0;
|
||||||
|
rtINT64 = 1;
|
||||||
|
rtFLOAT = 2;
|
||||||
|
|
||||||
|
type
|
||||||
|
Trint = array[1..8] of dword;
|
||||||
|
Trfloat = array[1..13] of double;
|
||||||
|
|
||||||
|
{$goto on}
|
||||||
|
{ define labels }
|
||||||
|
label
|
||||||
|
rfloat_loop,
|
||||||
|
stack_loop,
|
||||||
|
load_regs,
|
||||||
|
int_result,
|
||||||
|
int64_result,
|
||||||
|
float_result,
|
||||||
|
asmcall_end;
|
||||||
|
|
||||||
|
{ call a function from a pointer }
|
||||||
|
{ resulttype: 0 = int, 1 = int64, 2 = float }
|
||||||
|
function ppcasmcall(rint: Trint; rfloat: Trfloat; proc, stack: pointer; stacksize, resulttype: integer): pointer; assembler; nostackframe;
|
||||||
|
asm
|
||||||
|
mflr r0
|
||||||
|
stw r0, 8(r1)
|
||||||
|
|
||||||
|
{ save non-volatile register/s - make sure the stack size is sufficient! }
|
||||||
|
stw r31, -4(r1) { stacksize }
|
||||||
|
|
||||||
|
stwu r1, -240(r1) { create stack }
|
||||||
|
|
||||||
|
{ get all the params into the stack }
|
||||||
|
stw r3, 48(r1) { rint }
|
||||||
|
stw r4, 52(r1) { rfloat }
|
||||||
|
stw r5, 56(r1) { proc }
|
||||||
|
stw r6, 60(r1) { stack }
|
||||||
|
stw r7, 64(r1) { stacksize }
|
||||||
|
stw r8, 68(r1) { resulttype }
|
||||||
|
{ result is stored in 72(r1) and 76(r1) (if returning int64) }
|
||||||
|
|
||||||
|
{ write rint array into stack }
|
||||||
|
lwz r2, 48(r1) { rint }
|
||||||
|
lfd f0, 0(r2)
|
||||||
|
stfd f0, 80(r1) { rint[1], rint[2] }
|
||||||
|
lfd f0, 8(r2)
|
||||||
|
stfd f0, 88(r1) { rint[3], rint[4] }
|
||||||
|
lfd f0, 16(r2)
|
||||||
|
stfd f0, 96(r1) { rint[5], rint[6] }
|
||||||
|
lfd f0, 24(r2)
|
||||||
|
stfd f0, 104(r1) { rint[7], rint[8] }
|
||||||
|
|
||||||
|
{ write rfloat array into stack }
|
||||||
|
lwz r2, 52(r1) { rfloat }
|
||||||
|
addi r4, r1, 112 { rfloat[1] from here upwards (8 bytes apart) }
|
||||||
|
subi r2, r2, 8 { src }
|
||||||
|
subi r4, r4, 8 { dest }
|
||||||
|
li r3, 13 { counter }
|
||||||
|
|
||||||
|
rfloat_loop:
|
||||||
|
subic. r3, r3, 1 { dec counter }
|
||||||
|
lfdu f0, 8(r2) { load rfloat[x] + update }
|
||||||
|
stfdu f0, 8(r4) { store rfloat[x] + update }
|
||||||
|
bne cr0, rfloat_loop
|
||||||
|
|
||||||
|
{ create new stack }
|
||||||
|
mflr r0
|
||||||
|
stw r0, 8(r1)
|
||||||
|
mr r12, r1 { remember previous stack to fill in regs later }
|
||||||
|
|
||||||
|
lwz r31, 64(r12) { load stacksize into r31 }
|
||||||
|
neg r3, r31 { negate }
|
||||||
|
stwux r1, r1, r3 { create new stack }
|
||||||
|
|
||||||
|
{ build up the stack here }
|
||||||
|
mr r3, r31 { counter }
|
||||||
|
subic. r3, r3, 24 { don't write first 24 }
|
||||||
|
blt cr0, load_regs { don't fill in stack if there is none }
|
||||||
|
|
||||||
|
lwz r2, 60(r12) { pointer to stack }
|
||||||
|
addi r2, r2, 24 { start of params }
|
||||||
|
subi r2, r2, 1 { src }
|
||||||
|
|
||||||
|
addi r4, r1, 24 { start of params }
|
||||||
|
subi r4, r4, 1 { dest }
|
||||||
|
|
||||||
|
stack_loop:
|
||||||
|
subic. r3, r3, 1 { dec counter }
|
||||||
|
lbzu r5, 1(r2) { load stack + update }
|
||||||
|
stbu r5, 1(r4) { store stack + update }
|
||||||
|
bne cr0, stack_loop
|
||||||
|
|
||||||
|
load_regs: { now load the registers from the previous stack in r12 }
|
||||||
|
lwz r3, 80(r12)
|
||||||
|
lwz r4, 84(r12)
|
||||||
|
lwz r5, 88(r12)
|
||||||
|
lwz r6, 92(r12)
|
||||||
|
lwz r7, 96(r12)
|
||||||
|
lwz r8, 100(r12)
|
||||||
|
lwz r9, 104(r12)
|
||||||
|
lwz r10, 108(r12)
|
||||||
|
|
||||||
|
lfd f1, 112(r12)
|
||||||
|
lfd f2, 120(r12)
|
||||||
|
lfd f3, 128(r12)
|
||||||
|
lfd f4, 136(r12)
|
||||||
|
lfd f5, 144(r12)
|
||||||
|
lfd f6, 152(r12)
|
||||||
|
lfd f7, 160(r12)
|
||||||
|
lfd f8, 168(r12)
|
||||||
|
lfd f9, 176(r12)
|
||||||
|
lfd f10, 184(r12)
|
||||||
|
lfd f11, 192(r12)
|
||||||
|
lfd f12, 200(r12)
|
||||||
|
lfd f13, 208(r12)
|
||||||
|
|
||||||
|
{ now call this function }
|
||||||
|
lwz r2, 56(r12) { proc }
|
||||||
|
mtctr r2 { move to ctr }
|
||||||
|
bctrl { branch and link to ctr }
|
||||||
|
|
||||||
|
{ restore stack - use stacksize in r31 }
|
||||||
|
add r1, r1, r31
|
||||||
|
lwz r0, 8(r1)
|
||||||
|
mtlr r0
|
||||||
|
|
||||||
|
{ check resulttype and put appropriate pointer into r3 }
|
||||||
|
lwz r2, 68(r1) { resulttype }
|
||||||
|
cmpwi cr0, r2, 0 { int result? }
|
||||||
|
beq cr0, int_result { branch if equal }
|
||||||
|
|
||||||
|
cmpwi cr0, r2, 1 { single result? }
|
||||||
|
beq cr0, int64_result { branch if equal }
|
||||||
|
|
||||||
|
|
||||||
|
float_result: { the result is a double}
|
||||||
|
stfd f1, 72(r1) { write f1 to result on stack }
|
||||||
|
b asmcall_end
|
||||||
|
|
||||||
|
|
||||||
|
int64_result: { the result is a single }
|
||||||
|
stw r3, 72(r1) { write high dword to result on stack }
|
||||||
|
stw r4, 76(r1) { write low dword to result on stack }
|
||||||
|
b asmcall_end
|
||||||
|
|
||||||
|
|
||||||
|
int_result: { the result is dword }
|
||||||
|
stw r3, 72(r1) { write r3 to result on stack }
|
||||||
|
|
||||||
|
|
||||||
|
asmcall_end: { epilogue }
|
||||||
|
addi r3, r1, 72 { pointer to result on the stack }
|
||||||
|
addi r1, r1, 240 { restore stack }
|
||||||
|
|
||||||
|
{ restore non-volatile register/s }
|
||||||
|
lwz r31, -4(r1)
|
||||||
|
|
||||||
|
lwz r0, 8(r1)
|
||||||
|
mtlr r0
|
||||||
|
blr
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
|
||||||
|
var
|
||||||
|
rint: Trint; { registers r3 to r10 }
|
||||||
|
rfloat: Trfloat; { registers f1 to f13 }
|
||||||
|
st: packed array of byte; { stack }
|
||||||
|
i, j, rindex, findex, stindex: integer;
|
||||||
|
fvar: PPSVariantIFC;
|
||||||
|
IsConstructor: Boolean;
|
||||||
|
{ add a dword to stack }
|
||||||
|
procedure addstackdword(value: dword);
|
||||||
|
begin
|
||||||
|
setlength(st, stindex+4);
|
||||||
|
pdword(@st[stindex])^ := value;
|
||||||
|
inc(stindex, 4);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ add a float to stack }
|
||||||
|
procedure addstackfloat(value: pointer; size: integer);
|
||||||
|
begin
|
||||||
|
setlength(st, stindex + (size * 4));
|
||||||
|
if size = 1
|
||||||
|
then psingle(@st[stindex])^ := single(value^)
|
||||||
|
else pdouble(@st[stindex])^ := double(value^);
|
||||||
|
inc(stindex, size*4);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ add to the general registers or overflow to stack }
|
||||||
|
procedure addgen(value: dword);
|
||||||
|
begin
|
||||||
|
if rindex <= 8
|
||||||
|
then begin
|
||||||
|
rint[rindex] := value;
|
||||||
|
inc(rindex);
|
||||||
|
addstackdword(value);
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
addstackdword(value);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ add to the float registers or overflow to stack }
|
||||||
|
{ size = 1 for single, 2 for double }
|
||||||
|
procedure addfloat(value: pointer; size: integer);
|
||||||
|
begin
|
||||||
|
if findex <= 13
|
||||||
|
then begin
|
||||||
|
if size = 1
|
||||||
|
then rfloat[findex] := single(value^)
|
||||||
|
else rfloat[findex] := double(value^);
|
||||||
|
inc(findex);
|
||||||
|
inc(rindex, size);
|
||||||
|
addstackfloat(value, size);
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
addstackfloat(value, size);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if (Integer(CallingConv) and 64) <> 0 then begin
|
||||||
|
IsConstructor := true;
|
||||||
|
CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 64);
|
||||||
|
end else IsConstructor := false;
|
||||||
|
|
||||||
|
rindex := 1;
|
||||||
|
findex := 1;
|
||||||
|
stindex := 24;
|
||||||
|
setlength(st, stindex);
|
||||||
|
Result := False;
|
||||||
|
|
||||||
|
{ the pointer of the result needs to be passed first in the case of some result types }
|
||||||
|
if assigned(res)
|
||||||
|
then begin
|
||||||
|
case res.atype.basetype of
|
||||||
|
btStaticArray, btRecord: addgen(dword(res.dta));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ process all parameters }
|
||||||
|
for i := 0 to Params.Count-1 do begin
|
||||||
|
if Params[i] = nil
|
||||||
|
then Exit;
|
||||||
|
fvar := Params[i];
|
||||||
|
|
||||||
|
{ cook dynamic arrays - fpc stores size-1 at @array-4 }
|
||||||
|
if (fvar.aType.BaseType = btArray)
|
||||||
|
then dec(pdword(pointer(fvar.dta^)-4)^);
|
||||||
|
|
||||||
|
if fvar.varparam
|
||||||
|
then begin { var param }
|
||||||
|
case fvar.aType.BaseType of
|
||||||
|
{ add var params here }
|
||||||
|
btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF}
|
||||||
|
btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
|
||||||
|
{$IFNDEF PS_NOINT64}, bts64{$ENDIF}: addgen(dword(fvar.dta)); { TODO: test all }
|
||||||
|
else begin
|
||||||
|
writeln(stderr, 'Parameter type not recognised!');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end; { case }
|
||||||
|
end else begin { not a var param }
|
||||||
|
case fvar.aType.BaseType of
|
||||||
|
// btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF}
|
||||||
|
// btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
|
||||||
|
// {$IFNDEF PS_NOINT64}, bts64{$ENDIF}: writeln('normal param');
|
||||||
|
|
||||||
|
{ add normal params here }
|
||||||
|
btString: addgen(dword(pstring(fvar.dta)^));
|
||||||
|
btU8, btS8: addgen(dword(pbyte(fvar.dta)^));
|
||||||
|
btU16, BtS16: addgen(dword(pword(fvar.dta)^));
|
||||||
|
btU32, btS32: addgen(dword(pdword(fvar.dta)^));
|
||||||
|
btSingle: addfloat(fvar.dta, 1);
|
||||||
|
btDouble, btExtended: addfloat(fvar.dta, 2);
|
||||||
|
btPChar: addgen(dword(ppchar(fvar.dta)^));
|
||||||
|
btChar: addgen(dword(pchar(fvar.dta)^));
|
||||||
|
{$IFNDEF PS_NOINT64}bts64:{$ENDIF} begin
|
||||||
|
addgen(dword(pint64(fvar.dta)^ shr 32));
|
||||||
|
addgen(dword(pint64(fvar.dta)^ and $ffffffff));
|
||||||
|
end;
|
||||||
|
btStaticArray: addgen(dword(fvar.dta));
|
||||||
|
btRecord: for j := 0 to (fvar.atype.realsize div 4)-1 do
|
||||||
|
addgen(pdword(fvar.dta + j*4)^);
|
||||||
|
btArray: addgen(dword(fvar.dta^));
|
||||||
|
|
||||||
|
{ TODO add and test }
|
||||||
|
{ btVariant, btSet, btInterface, btClass }
|
||||||
|
|
||||||
|
else begin
|
||||||
|
writeln(stderr, 'Parameter type not implemented!');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end; { case }
|
||||||
|
end; { else }
|
||||||
|
end; { for }
|
||||||
|
|
||||||
|
if not assigned(res)
|
||||||
|
then begin
|
||||||
|
ppcasmcall(rint, rfloat, address, st, stindex, rtINT); { ignore return }
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
case res.atype.basetype of
|
||||||
|
{ add result types here }
|
||||||
|
btString: pstring(res.dta)^ := pstring(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^;
|
||||||
|
btU8, btS8: pbyte(res.dta)^ := byte(pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^);
|
||||||
|
btU16, btS16: pword(res.dta)^ := word(pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^);
|
||||||
|
btU32, btS32: pdword(res.dta)^ := pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^;
|
||||||
|
btSingle: psingle(res.dta)^ := pdouble(ppcasmcall(rint, rfloat, address, st, stindex, rtFLOAT))^;
|
||||||
|
btDouble, btExtended: pdouble(res.dta)^ := pdouble(ppcasmcall(rint, rfloat, address, st, stindex, rtFLOAT))^;
|
||||||
|
btPChar: ppchar(res.dta)^ := pchar(pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^);
|
||||||
|
btChar: pchar(res.dta)^ := char(pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^);
|
||||||
|
btStaticArray, btRecord: ppcasmcall(rint, rfloat, address, st, stindex, rtINT);
|
||||||
|
btArray: res.dta := ppcasmcall(rint, rfloat, address, st, stindex, rtINT);
|
||||||
|
|
||||||
|
{ TODO add and test }
|
||||||
|
|
||||||
|
else begin
|
||||||
|
writeln(stderr, 'Result type not implemented!');
|
||||||
|
exit;
|
||||||
|
end; { else }
|
||||||
|
end; { case }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ cook dynamic arrays - fpc stores size-1 at @array-4 }
|
||||||
|
for i := 0 to Params.Count-1 do begin
|
||||||
|
fvar := Params[i];
|
||||||
|
if (fvar.aType.BaseType = btArray)
|
||||||
|
then inc(pdword(pointer(fvar.dta^)-4)^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
892
Units/PascalScript/uPSC_DB.pas
Normal file
892
Units/PascalScript/uPSC_DB.pas
Normal file
@ -0,0 +1,892 @@
|
|||||||
|
{ Compiletime DB support }
|
||||||
|
Unit uPSC_DB;
|
||||||
|
{
|
||||||
|
This file has been generated by UnitParser v0.4, written by M. Knight.
|
||||||
|
Source Code from Carlo Kok has been used to implement various sections of
|
||||||
|
UnitParser. Components of ifps3 are used in the construction of UnitParser,
|
||||||
|
code implementing the class wrapper is taken from Carlo Kok''s conv unility
|
||||||
|
|
||||||
|
Licence :
|
||||||
|
This software is provided 'as-is', without any expressed or implied
|
||||||
|
warranty. In no event will the author be held liable for any damages
|
||||||
|
arising from the use of this software.
|
||||||
|
Permission is granted to anyone to use this software for any kind of
|
||||||
|
application, and to alter it and redistribute it freely, subject to
|
||||||
|
the following restrictions:
|
||||||
|
1. The origin of this software must not be misrepresented, you must
|
||||||
|
not claim that you wrote the original software.
|
||||||
|
2. Altered source versions must be plainly marked as such, and must
|
||||||
|
not be misrepresented as being the original software.
|
||||||
|
3. You may not create a library that uses this library as a main part
|
||||||
|
of the program and sell that library.
|
||||||
|
4. You must have a visible line in your programs aboutbox or
|
||||||
|
documentation that it is made using Innerfuse Script and where
|
||||||
|
Innerfuse Pascal Script can be found.
|
||||||
|
5. This notice may not be removed or altered from any source
|
||||||
|
distribution.
|
||||||
|
|
||||||
|
If you have any questions concerning this license write to Carlo Kok:
|
||||||
|
ck@carlo-kok.com or try the newsserver:
|
||||||
|
news://news.carlo-kok.com/
|
||||||
|
}
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
Interface
|
||||||
|
uses
|
||||||
|
uPSCompiler;
|
||||||
|
|
||||||
|
procedure SIRegisterTDATASET(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPARAMS(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPARAM(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTGUIDFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTVARIANTFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTREFERENCEFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTDATASETFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTARRAYFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTADTFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTOBJECTFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTGRAPHICFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTMEMOFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBLOBFIELD(CL: TPSPascalCompiler);
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
procedure SIRegisterTFMTBCDFIELD(CL: TPSPascalCompiler);
|
||||||
|
{$ENDIF}
|
||||||
|
procedure SIRegisterTBCDFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTVARBYTESFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBYTESFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBINARYFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTTIMEFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTDATEFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTDATETIMEFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBOOLEANFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCURRENCYFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFLOATFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTAUTOINCFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTWORDFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTLARGEINTFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTSMALLINTFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTINTEGERFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTNUMERICFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTWIDESTRINGFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTSTRINGFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFIELD(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTLOOKUPLIST(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFIELDS(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFIELDLIST(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFIELDDEFLIST(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFLATLIST(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTINDEXDEFS(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTINDEXDEF(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFIELDDEFS(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFIELDDEF(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTDEFCOLLECTION(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTNAMEDITEM(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegister_DB(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
Uses Sysutils;
|
||||||
|
|
||||||
|
Function RegClassS(cl : TPSPascalCompiler;Const InheritsFrom,Classname : String) : TPSCompileTimeClass;
|
||||||
|
begin
|
||||||
|
Result := cl.FindClass(Classname);
|
||||||
|
if Result = nil then
|
||||||
|
Result := cl.AddClassN(cl.FindClass(InheritsFrom),Classname)
|
||||||
|
else
|
||||||
|
Result.ClassInheritsFrom := cl.FindClass(InheritsFrom);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTDATASET(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TCOMPONENT','TDATASET') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Function ACTIVEBUFFER : PCHAR');
|
||||||
|
RegisterMethod('Procedure APPEND');
|
||||||
|
RegisterMethod('Procedure APPENDRECORD( const VALUES : array of const)');
|
||||||
|
// RegisterMethod('Function BOOKMARKVALID( BOOKMARK : TBOOKMARK) : BOOLEAN');
|
||||||
|
RegisterMethod('Procedure CANCEL');
|
||||||
|
RegisterMethod('Procedure CHECKBROWSEMODE');
|
||||||
|
RegisterMethod('Procedure CLEARFIELDS');
|
||||||
|
RegisterMethod('Procedure CLOSE');
|
||||||
|
RegisterMethod('Function CONTROLSDISABLED : BOOLEAN');
|
||||||
|
// RegisterMethod('Function COMPAREBOOKMARKS( BOOKMARK1, BOOKMARK2 : TBOOKMARK) : INTEGER');
|
||||||
|
RegisterMethod('Function CREATEBLOBSTREAM( FIELD : TFIELD; MODE : TBLOBSTREAMMODE) : TSTREAM');
|
||||||
|
RegisterMethod('Procedure CURSORPOSCHANGED');
|
||||||
|
RegisterMethod('Procedure DELETE');
|
||||||
|
RegisterMethod('Procedure DISABLECONTROLS');
|
||||||
|
RegisterMethod('Procedure EDIT');
|
||||||
|
RegisterMethod('Procedure ENABLECONTROLS');
|
||||||
|
{$IFDEF DELPHI2006UP}
|
||||||
|
RegisterMethod('Function FIELDBYNAME( const FIELDNAME : WIDESTRING) : TFIELD');
|
||||||
|
RegisterMethod('Function FINDFIELD( const FIELDNAME : WideString) : TFIELD');
|
||||||
|
{$ELSE}
|
||||||
|
RegisterMethod('Function FIELDBYNAME( const FIELDNAME : STRING) : TFIELD');
|
||||||
|
RegisterMethod('Function FINDFIELD( const FIELDNAME : STRING) : TFIELD');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod('Function FINDFIRST : BOOLEAN');
|
||||||
|
RegisterMethod('Function FINDLAST : BOOLEAN');
|
||||||
|
RegisterMethod('Function FINDNEXT : BOOLEAN');
|
||||||
|
RegisterMethod('Function FINDPRIOR : BOOLEAN');
|
||||||
|
RegisterMethod('Procedure FIRST');
|
||||||
|
// RegisterMethod('Procedure FREEBOOKMARK( BOOKMARK : TBOOKMARK)');
|
||||||
|
// RegisterMethod('Function GETBOOKMARK : TBOOKMARK');
|
||||||
|
RegisterMethod('Function GETCURRENTRECORD( BUFFER : PCHAR) : BOOLEAN');
|
||||||
|
// RegisterMethod('Procedure GETDETAILDATASETS( LIST : TLIST)');
|
||||||
|
// RegisterMethod('Procedure GETFIELDLIST( LIST : TLIST; const FIELDNAMES : STRING)');
|
||||||
|
// RegisterMethod('Procedure GETDETAILLINKFIELDS( MASTERFIELDS, DETAILFIELDS : TLIST)');
|
||||||
|
// RegisterMethod('Function GETBLOBFIELDDATA( FIELDNO : INTEGER; var BUFFER : TBLOBBYTEDATA) : INTEGER');
|
||||||
|
RegisterMethod('Procedure GETFIELDNAMES( LIST : TSTRINGS)');
|
||||||
|
// RegisterMethod('Procedure GOTOBOOKMARK( BOOKMARK : TBOOKMARK)');
|
||||||
|
RegisterMethod('Procedure INSERT');
|
||||||
|
RegisterMethod('Procedure INSERTRECORD( const VALUES : array of const)');
|
||||||
|
RegisterMethod('Function ISEMPTY : BOOLEAN');
|
||||||
|
RegisterMethod('Function ISLINKEDTO( DATASOURCE : TDATASOURCE) : BOOLEAN');
|
||||||
|
RegisterMethod('Function ISSEQUENCED : BOOLEAN');
|
||||||
|
RegisterMethod('Procedure LAST');
|
||||||
|
RegisterMethod('Function LOCATE( const KEYFIELDS : String; const KEYVALUES : VARIANT; OPTIONS : TLOCATEOPTIONS) : BOOLEAN');
|
||||||
|
RegisterMethod('Function LOOKUP( const KEYFIELDS : String; const KEYVALUES : VARIANT; const RESULTFIELDS : String) : VARIANT');
|
||||||
|
RegisterMethod('Function MOVEBY( DISTANCE : INTEGER) : INTEGER');
|
||||||
|
RegisterMethod('Procedure NEXT');
|
||||||
|
RegisterMethod('Procedure OPEN');
|
||||||
|
RegisterMethod('Procedure POST');
|
||||||
|
RegisterMethod('Procedure PRIOR');
|
||||||
|
RegisterMethod('Procedure REFRESH');
|
||||||
|
// RegisterMethod('Procedure RESYNC( MODE : TRESYNCMODE)');
|
||||||
|
RegisterMethod('Procedure SETFIELDS( const VALUES : array of const)');
|
||||||
|
RegisterMethod('Function TRANSLATE( SRC, DEST : PCHAR; TOOEM : BOOLEAN) : INTEGER');
|
||||||
|
RegisterMethod('Procedure UPDATECURSORPOS');
|
||||||
|
RegisterMethod('Procedure UPDATERECORD');
|
||||||
|
RegisterMethod('Function UPDATESTATUS : TUPDATESTATUS');
|
||||||
|
RegisterProperty('AGGFIELDS', 'TFIELDS', iptr);
|
||||||
|
RegisterProperty('BOF', 'BOOLEAN', iptr);
|
||||||
|
// RegisterProperty('BOOKMARK', 'TBOOKMARKSTR', iptrw);
|
||||||
|
RegisterProperty('CANMODIFY', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('DATASETFIELD', 'TDATASETFIELD', iptrw);
|
||||||
|
RegisterProperty('DATASOURCE', 'TDATASOURCE', iptr);
|
||||||
|
RegisterProperty('DEFAULTFIELDS', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('DESIGNER', 'TDATASETDESIGNER', iptr);
|
||||||
|
RegisterProperty('EOF', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('BLOCKREADSIZE', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('FIELDCOUNT', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('FIELDDEFS', 'TFIELDDEFS', iptrw);
|
||||||
|
RegisterProperty('FIELDDEFLIST', 'TFIELDDEFLIST', iptr);
|
||||||
|
RegisterProperty('FIELDS', 'TFIELDS', iptr);
|
||||||
|
RegisterProperty('FIELDLIST', 'TFIELDLIST', iptr);
|
||||||
|
RegisterProperty('FIELDVALUES', 'VARIANT String', iptrw);
|
||||||
|
RegisterProperty('FOUND', 'BOOLEAN', iptr);
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
RegisterProperty('ISUNIDIRECTIONAL', 'BOOLEAN', iptr);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('MODIFIED', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('OBJECTVIEW', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('RECORDCOUNT', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('RECNO', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('RECORDSIZE', 'WORD', iptr);
|
||||||
|
RegisterProperty('SPARSEARRAYS', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('STATE', 'TDATASETSTATE', iptr);
|
||||||
|
RegisterProperty('FILTER', 'String', iptrw);
|
||||||
|
RegisterProperty('FILTERED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('FILTEROPTIONS', 'TFILTEROPTIONS', iptrw);
|
||||||
|
RegisterProperty('ACTIVE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('AUTOCALCFIELDS', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('BEFOREOPEN', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTEROPEN', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('BEFORECLOSE', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTERCLOSE', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('BEFOREINSERT', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTERINSERT', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('BEFOREEDIT', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTEREDIT', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('BEFOREPOST', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTERPOST', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('BEFORECANCEL', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTERCANCEL', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('BEFOREDELETE', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTERDELETE', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('BEFORESCROLL', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTERSCROLL', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('BEFOREREFRESH', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('AFTERREFRESH', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONCALCFIELDS', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONDELETEERROR', 'TDATASETERROREVENT', iptrw);
|
||||||
|
RegisterProperty('ONEDITERROR', 'TDATASETERROREVENT', iptrw);
|
||||||
|
RegisterProperty('ONFILTERRECORD', 'TFILTERRECORDEVENT', iptrw);
|
||||||
|
RegisterProperty('ONNEWRECORD', 'TDATASETNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONPOSTERROR', 'TDATASETERROREVENT', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPARAMS(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TCOLLECTION','TPARAMS') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Procedure ASSIGNVALUES( VALUE : TPARAMS)');
|
||||||
|
RegisterMethod('Procedure ADDPARAM( VALUE : TPARAM)');
|
||||||
|
RegisterMethod('Procedure REMOVEPARAM( VALUE : TPARAM)');
|
||||||
|
RegisterMethod('Function CREATEPARAM( FLDTYPE : TFIELDTYPE; const PARAMNAME : String; PARAMTYPE : TPARAMTYPE) : TPARAM');
|
||||||
|
// RegisterMethod('Procedure GETPARAMLIST( LIST : TLIST; const PARAMNAMES : STRING)');
|
||||||
|
RegisterMethod('Function ISEQUAL( VALUE : TPARAMS) : BOOLEAN');
|
||||||
|
RegisterMethod('Function PARSESQL( SQL : String; DOCREATE : BOOLEAN) : String');
|
||||||
|
RegisterMethod('Function PARAMBYNAME( const VALUE : String) : TPARAM');
|
||||||
|
RegisterMethod('Function FINDPARAM( const VALUE : String) : TPARAM');
|
||||||
|
RegisterProperty('ITEMS', 'TPARAM INTEGER', iptrw);
|
||||||
|
RegisterProperty('PARAMVALUES', 'VARIANT String', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPARAM(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TCOLLECTIONITEM','TPARAM') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Procedure ASSIGNFIELD( FIELD : TFIELD)');
|
||||||
|
RegisterMethod('Procedure ASSIGNFIELDVALUE( FIELD : TFIELD; const VALUE : VARIANT)');
|
||||||
|
RegisterMethod('Procedure CLEAR');
|
||||||
|
// RegisterMethod('Procedure GETDATA( BUFFER : POINTER)');
|
||||||
|
RegisterMethod('Function GETDATASIZE : INTEGER');
|
||||||
|
RegisterMethod('Procedure LOADFROMFILE( const FILENAME : String; BLOBTYPE : TBLOBTYPE)');
|
||||||
|
RegisterMethod('Procedure LOADFROMSTREAM( STREAM : TSTREAM; BLOBTYPE : TBLOBTYPE)');
|
||||||
|
// RegisterMethod('Procedure SETBLOBDATA( BUFFER : POINTER; SIZE : INTEGER)');
|
||||||
|
// RegisterMethod('Procedure SETDATA( BUFFER : POINTER)');
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
RegisterProperty('ASBCD', 'CURRENCY', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
RegisterProperty('ASFMTBCD', 'TBCD', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('ASBLOB', 'TBLOBDATA', iptrw);
|
||||||
|
RegisterProperty('ASBOOLEAN', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ASCURRENCY', 'CURRENCY', iptrw);
|
||||||
|
RegisterProperty('ASDATE', 'TDATETIME', iptrw);
|
||||||
|
RegisterProperty('ASDATETIME', 'TDATETIME', iptrw);
|
||||||
|
RegisterProperty('ASFLOAT', 'DOUBLE', iptrw);
|
||||||
|
RegisterProperty('ASINTEGER', 'LONGINT', iptrw);
|
||||||
|
RegisterProperty('ASSMALLINT', 'LONGINT', iptrw);
|
||||||
|
RegisterProperty('ASMEMO', 'String', iptrw);
|
||||||
|
RegisterProperty('ASSTRING', 'String', iptrw);
|
||||||
|
RegisterProperty('ASTIME', 'TDATETIME', iptrw);
|
||||||
|
RegisterProperty('ASWORD', 'LONGINT', iptrw);
|
||||||
|
RegisterProperty('BOUND', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ISNULL', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('NATIVESTR', 'String', iptrw);
|
||||||
|
RegisterProperty('TEXT', 'String', iptrw);
|
||||||
|
RegisterProperty('DATATYPE', 'TFIELDTYPE', iptrw);
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
RegisterProperty('PRECISION', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('NUMERICSCALE', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('SIZE', 'INTEGER', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('NAME', 'String', iptrw);
|
||||||
|
RegisterProperty('PARAMTYPE', 'TPARAMTYPE', iptrw);
|
||||||
|
RegisterProperty('VALUE', 'VARIANT', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTGUIDFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TGUIDFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTVARIANTFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TVARIANTFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTREFERENCEFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TDATASETFIELD','TREFERENCEFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('REFERENCETABLENAME', 'String', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTDATASETFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TOBJECTFIELD','TDATASETFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('NESTEDDATASET', 'TDATASET', iptr);
|
||||||
|
RegisterProperty('INCLUDEOBJECTFIELD', 'BOOLEAN', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTARRAYFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TOBJECTFIELD','TARRAYFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTADTFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TOBJECTFIELD','TADTFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTOBJECTFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TOBJECTFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('FIELDCOUNT', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('FIELDS', 'TFIELDS', iptr);
|
||||||
|
RegisterProperty('FIELDVALUES', 'VARIANT INTEGER', iptrw);
|
||||||
|
RegisterProperty('UNNAMED', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('OBJECTTYPE', 'String', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTGRAPHICFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TBLOBFIELD','TGRAPHICFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTMEMOFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TBLOBFIELD','TMEMOFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTBLOBFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TBLOBFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Procedure LOADFROMFILE( const FILENAME : String)');
|
||||||
|
RegisterMethod('Procedure LOADFROMSTREAM( STREAM : TSTREAM)');
|
||||||
|
RegisterMethod('Procedure SAVETOFILE( const FILENAME : String)');
|
||||||
|
RegisterMethod('Procedure SAVETOSTREAM( STREAM : TSTREAM)');
|
||||||
|
RegisterProperty('BLOBSIZE', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('MODIFIED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('VALUE', 'String', iptrw);
|
||||||
|
RegisterProperty('TRANSLITERATE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('BLOBTYPE', 'TBLOBTYPE', iptrw);
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
RegisterProperty('GRAPHICHEADER', 'BOOLEAN', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
procedure SIRegisterTFMTBCDFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TNUMERICFIELD','TFMTBCDFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('VALUE', 'TBCD', iptrw);
|
||||||
|
RegisterProperty('CURRENCY', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('MAXVALUE', 'String', iptrw);
|
||||||
|
RegisterProperty('MINVALUE', 'String', iptrw);
|
||||||
|
RegisterProperty('PRECISION', 'INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure SIRegisterTBCDFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TNUMERICFIELD','TBCDFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('VALUE', 'CURRENCY', iptrw);
|
||||||
|
RegisterProperty('CURRENCY', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('MAXVALUE', 'CURRENCY', iptrw);
|
||||||
|
RegisterProperty('MINVALUE', 'CURRENCY', iptrw);
|
||||||
|
RegisterProperty('PRECISION', 'INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTVARBYTESFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TBYTESFIELD','TVARBYTESFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTBYTESFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TBINARYFIELD','TBYTESFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTBINARYFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TBINARYFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTTIMEFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TDATETIMEFIELD','TTIMEFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTDATEFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TDATETIMEFIELD','TDATEFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTDATETIMEFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TDATETIMEFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('VALUE', 'TDATETIME', iptrw);
|
||||||
|
RegisterProperty('DISPLAYFORMAT', 'String', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTBOOLEANFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TBOOLEANFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('VALUE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('DISPLAYVALUES', 'String', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTCURRENCYFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFLOATFIELD','TCURRENCYFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFLOATFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TNUMERICFIELD','TFLOATFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('VALUE', 'DOUBLE', iptrw);
|
||||||
|
RegisterProperty('CURRENCY', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('MAXVALUE', 'DOUBLE', iptrw);
|
||||||
|
RegisterProperty('MINVALUE', 'DOUBLE', iptrw);
|
||||||
|
RegisterProperty('PRECISION', 'INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTAUTOINCFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TINTEGERFIELD','TAUTOINCFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTWORDFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TINTEGERFIELD','TWORDFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTLARGEINTFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TNUMERICFIELD','TLARGEINTFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ASLARGEINT', 'LARGEINT', iptrw);
|
||||||
|
RegisterProperty('VALUE', 'LARGEINT', iptrw);
|
||||||
|
RegisterProperty('MAXVALUE', 'LARGEINT', iptrw);
|
||||||
|
RegisterProperty('MINVALUE', 'LARGEINT', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTSMALLINTFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TINTEGERFIELD','TSMALLINTFIELD') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTINTEGERFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TNUMERICFIELD','TINTEGERFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('VALUE', 'LONGINT', iptrw);
|
||||||
|
RegisterProperty('MAXVALUE', 'LONGINT', iptrw);
|
||||||
|
RegisterProperty('MINVALUE', 'LONGINT', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTNUMERICFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TNUMERICFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('DISPLAYFORMAT', 'String', iptrw);
|
||||||
|
RegisterProperty('EDITFORMAT', 'String', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTWIDESTRINGFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TSTRINGFIELD','TWIDESTRINGFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('VALUE', 'WIDESTRING', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTSTRINGFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFIELD','TSTRINGFIELD') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('VALUE', 'String', iptrw);
|
||||||
|
RegisterProperty('FIXEDCHAR', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('TRANSLITERATE', 'BOOLEAN', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFIELD(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TCOMPONENT','TFIELD') do
|
||||||
|
begin
|
||||||
|
//RegisterMethod('Procedure ASSIGNVALUE( const VALUE : TVARREC)');
|
||||||
|
RegisterMethod('Procedure CLEAR');
|
||||||
|
RegisterMethod('Procedure FOCUSCONTROL');
|
||||||
|
// RegisterMethod('Function GETDATA( BUFFER : POINTER; NATIVEFORMAT : BOOLEAN) : BOOLEAN');
|
||||||
|
RegisterMethod('Function ISVALIDCHAR( INPUTCHAR : CHAR) : BOOLEAN');
|
||||||
|
RegisterMethod('Procedure REFRESHLOOKUPLIST');
|
||||||
|
// RegisterMethod('Procedure SETDATA( BUFFER : POINTER; NATIVEFORMAT : BOOLEAN)');
|
||||||
|
RegisterMethod('Procedure SETFIELDTYPE( VALUE : TFIELDTYPE)');
|
||||||
|
// RegisterMethod('Procedure VALIDATE( BUFFER : POINTER)');
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
RegisterProperty('ASBCD', 'TBCD', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('ASBOOLEAN', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ASCURRENCY', 'CURRENCY', iptrw);
|
||||||
|
RegisterProperty('ASDATETIME', 'TDATETIME', iptrw);
|
||||||
|
RegisterProperty('ASFLOAT', 'DOUBLE', iptrw);
|
||||||
|
RegisterProperty('ASINTEGER', 'LONGINT', iptrw);
|
||||||
|
RegisterProperty('ASSTRING', 'String', iptrw);
|
||||||
|
RegisterProperty('ASVARIANT', 'VARIANT', iptrw);
|
||||||
|
RegisterProperty('ATTRIBUTESET', 'String', iptrw);
|
||||||
|
RegisterProperty('CALCULATED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('CANMODIFY', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('CURVALUE', 'VARIANT', iptr);
|
||||||
|
RegisterProperty('DATASET', 'TDATASET', iptrw);
|
||||||
|
RegisterProperty('DATASIZE', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('DATATYPE', 'TFIELDTYPE', iptr);
|
||||||
|
RegisterProperty('DISPLAYNAME', 'String', iptr);
|
||||||
|
RegisterProperty('DISPLAYTEXT', 'String', iptr);
|
||||||
|
RegisterProperty('EDITMASK', 'TEDITMASK', iptrw);
|
||||||
|
RegisterProperty('EDITMASKPTR', 'TEDITMASK', iptr);
|
||||||
|
RegisterProperty('EDITMASK', 'String', iptrw);
|
||||||
|
RegisterProperty('EDITMASKPTR', 'String', iptr);
|
||||||
|
RegisterProperty('FIELDNO', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('FULLNAME', 'String', iptr);
|
||||||
|
RegisterProperty('ISINDEXFIELD', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('ISNULL', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('LOOKUP', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('LOOKUPLIST', 'TLOOKUPLIST', iptr);
|
||||||
|
RegisterProperty('NEWVALUE', 'VARIANT', iptrw);
|
||||||
|
RegisterProperty('OFFSET', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('OLDVALUE', 'VARIANT', iptr);
|
||||||
|
RegisterProperty('PARENTFIELD', 'TOBJECTFIELD', iptrw);
|
||||||
|
RegisterProperty('SIZE', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('TEXT', 'String', iptrw);
|
||||||
|
RegisterProperty('VALIDCHARS', 'TFIELDCHARS', iptrw);
|
||||||
|
RegisterProperty('VALUE', 'VARIANT', iptrw);
|
||||||
|
RegisterProperty('ALIGNMENT', 'TALIGNMENT', iptrw);
|
||||||
|
RegisterProperty('AUTOGENERATEVALUE', 'TAUTOREFRESHFLAG', iptrw);
|
||||||
|
RegisterProperty('CUSTOMCONSTRAINT', 'String', iptrw);
|
||||||
|
RegisterProperty('CONSTRAINTERRORMESSAGE', 'String', iptrw);
|
||||||
|
RegisterProperty('DEFAULTEXPRESSION', 'String', iptrw);
|
||||||
|
RegisterProperty('DISPLAYLABEL', 'String', iptrw);
|
||||||
|
RegisterProperty('DISPLAYWIDTH', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('FIELDKIND', 'TFIELDKIND', iptrw);
|
||||||
|
RegisterProperty('FIELDNAME', 'String', iptrw);
|
||||||
|
RegisterProperty('HASCONSTRAINTS', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('INDEX', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('IMPORTEDCONSTRAINT', 'String', iptrw);
|
||||||
|
RegisterProperty('LOOKUPDATASET', 'TDATASET', iptrw);
|
||||||
|
RegisterProperty('LOOKUPKEYFIELDS', 'String', iptrw);
|
||||||
|
RegisterProperty('LOOKUPRESULTFIELD', 'String', iptrw);
|
||||||
|
RegisterProperty('KEYFIELDS', 'String', iptrw);
|
||||||
|
RegisterProperty('LOOKUPCACHE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ORIGIN', 'String', iptrw);
|
||||||
|
RegisterProperty('PROVIDERFLAGS', 'TPROVIDERFLAGS', iptrw);
|
||||||
|
RegisterProperty('READONLY', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('REQUIRED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('VISIBLE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ONCHANGE', 'TFIELDNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONGETTEXT', 'TFIELDGETTEXTEVENT', iptrw);
|
||||||
|
RegisterProperty('ONSETTEXT', 'TFIELDSETTEXTEVENT', iptrw);
|
||||||
|
RegisterProperty('ONVALIDATE', 'TFIELDNOTIFYEVENT', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTLOOKUPLIST(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TOBJECT','TLOOKUPLIST') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor CREATE');
|
||||||
|
RegisterMethod('Procedure ADD( const AKEY, AVALUE : VARIANT)');
|
||||||
|
RegisterMethod('Procedure CLEAR');
|
||||||
|
RegisterMethod('Function VALUEOFKEY( const AKEY : VARIANT) : VARIANT');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFIELDS(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TOBJECT','TFIELDS') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor CREATE( ADATASET : TDATASET)');
|
||||||
|
RegisterMethod('Procedure ADD( FIELD : TFIELD)');
|
||||||
|
RegisterMethod('Procedure CHECKFIELDNAME( const FIELDNAME : String)');
|
||||||
|
RegisterMethod('Procedure CHECKFIELDNAMES( const FIELDNAMES : String)');
|
||||||
|
RegisterMethod('Procedure CLEAR');
|
||||||
|
RegisterMethod('Function FINDFIELD( const FIELDNAME : String) : TFIELD');
|
||||||
|
RegisterMethod('Function FIELDBYNAME( const FIELDNAME : String) : TFIELD');
|
||||||
|
RegisterMethod('Function FIELDBYNUMBER( FIELDNO : INTEGER) : TFIELD');
|
||||||
|
RegisterMethod('Procedure GETFIELDNAMES( LIST : TSTRINGS)');
|
||||||
|
RegisterMethod('Function INDEXOF( FIELD : TFIELD) : INTEGER');
|
||||||
|
RegisterMethod('Procedure REMOVE( FIELD : TFIELD)');
|
||||||
|
RegisterProperty('COUNT', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('DATASET', 'TDATASET', iptr);
|
||||||
|
RegisterProperty('FIELDS', 'TFIELD INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFIELDLIST(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFLATLIST','TFIELDLIST') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Function FIELDBYNAME( const NAME : String) : TFIELD');
|
||||||
|
RegisterMethod('Function FIND( const NAME : String) : TFIELD');
|
||||||
|
RegisterProperty('FIELDS', 'TFIELD INTEGER', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFIELDDEFLIST(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TFLATLIST','TFIELDDEFLIST') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Function FIELDBYNAME( const NAME : String) : TFIELDDEF');
|
||||||
|
RegisterMethod('Function FIND( const NAME : String) : TFIELDDEF');
|
||||||
|
RegisterProperty('FIELDDEFS', 'TFIELDDEF INTEGER', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFLATLIST(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TSTRINGLIST','TFLATLIST') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor CREATE( ADATASET : TDATASET)');
|
||||||
|
RegisterMethod('Procedure UPDATE');
|
||||||
|
RegisterProperty('DATASET', 'TDATASET', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTINDEXDEFS(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TDEFCOLLECTION','TINDEXDEFS') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor CREATE( ADATASET : TDATASET)');
|
||||||
|
RegisterMethod('Function ADDINDEXDEF : TINDEXDEF');
|
||||||
|
RegisterMethod('Function FIND( const NAME : String) : TINDEXDEF');
|
||||||
|
RegisterMethod('Procedure UPDATE');
|
||||||
|
RegisterMethod('Function FINDINDEXFORFIELDS( const FIELDS : String) : TINDEXDEF');
|
||||||
|
RegisterMethod('Function GETINDEXFORFIELDS( const FIELDS : String; CASEINSENSITIVE : BOOLEAN) : TINDEXDEF');
|
||||||
|
RegisterMethod('Procedure ADD( const NAME, FIELDS : String; OPTIONS : TINDEXOPTIONS)');
|
||||||
|
RegisterProperty('ITEMS', 'TINDEXDEF INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTINDEXDEF(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TNAMEDITEM','TINDEXDEF') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor CREATE( OWNER : TINDEXDEFS; const NAME, FIELDS : String; OPTIONS : TINDEXOPTIONS)');
|
||||||
|
RegisterProperty('FIELDEXPRESSION', 'String', iptr);
|
||||||
|
RegisterProperty('CASEINSFIELDS', 'String', iptrw);
|
||||||
|
RegisterProperty('DESCFIELDS', 'String', iptrw);
|
||||||
|
RegisterProperty('EXPRESSION', 'String', iptrw);
|
||||||
|
RegisterProperty('FIELDS', 'String', iptrw);
|
||||||
|
RegisterProperty('OPTIONS', 'TINDEXOPTIONS', iptrw);
|
||||||
|
RegisterProperty('SOURCE', 'String', iptrw);
|
||||||
|
RegisterProperty('GROUPINGLEVEL', 'INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFIELDDEFS(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TDEFCOLLECTION','TFIELDDEFS') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor CREATE( AOWNER : TPERSISTENT)');
|
||||||
|
RegisterMethod('Function ADDFIELDDEF : TFIELDDEF');
|
||||||
|
RegisterMethod('Function FIND( const NAME : String) : TFIELDDEF');
|
||||||
|
RegisterMethod('Procedure UPDATE');
|
||||||
|
RegisterMethod('Procedure ADD( const NAME : String; DATATYPE : TFIELDTYPE; SIZE : INTEGER; REQUIRED : BOOLEAN)');
|
||||||
|
RegisterProperty('HIDDENFIELDS', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ITEMS', 'TFIELDDEF INTEGER', iptrw);
|
||||||
|
RegisterProperty('PARENTDEF', 'TFIELDDEF', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFIELDDEF(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TNAMEDITEM','TFIELDDEF') do
|
||||||
|
begin
|
||||||
|
// RegisterMethod('Constructor CREATE( OWNER : TFIELDDEFS; const NAME : STRING; DATATYPE : TFIELDTYPE; SIZE : INTEGER; REQUIRED : BOOLEAN; FIELDNO : INTEGER)');
|
||||||
|
RegisterMethod('Function ADDCHILD : TFIELDDEF');
|
||||||
|
RegisterMethod('Function CREATEFIELD( OWNER : TCOMPONENT; PARENTFIELD : TOBJECTFIELD; const FIELDNAME : String; CREATECHILDREN : BOOLEAN) : TFIELD');
|
||||||
|
RegisterMethod('Function HASCHILDDEFS : BOOLEAN');
|
||||||
|
RegisterProperty('FIELDCLASS', 'TFIELDCLASS', iptr);
|
||||||
|
RegisterProperty('FIELDNO', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('INTERNALCALCFIELD', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('PARENTDEF', 'TFIELDDEF', iptr);
|
||||||
|
RegisterProperty('REQUIRED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ATTRIBUTES', 'TFIELDATTRIBUTES', iptrw);
|
||||||
|
RegisterProperty('CHILDDEFS', 'TFIELDDEFS', iptrw);
|
||||||
|
RegisterProperty('DATATYPE', 'TFIELDTYPE', iptrw);
|
||||||
|
RegisterProperty('PRECISION', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('SIZE', 'INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTDEFCOLLECTION(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TOWNEDCOLLECTION','TDEFCOLLECTION') do
|
||||||
|
begin
|
||||||
|
// RegisterMethod('Constructor CREATE( ADATASET : TDATASET; AOWNER : TPERSISTENT; ACLASS : TCOLLECTIONITEMCLASS)');
|
||||||
|
RegisterMethod('Function FIND( const ANAME : String) : TNAMEDITEM');
|
||||||
|
RegisterMethod('Procedure GETITEMNAMES( LIST : TSTRINGS)');
|
||||||
|
RegisterMethod('Function INDEXOF( const ANAME : String) : INTEGER');
|
||||||
|
RegisterProperty('DATASET', 'TDATASET', iptr);
|
||||||
|
RegisterProperty('UPDATED', 'BOOLEAN', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTNAMEDITEM(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With RegClassS(cl,'TCOLLECTIONITEM','TNAMEDITEM') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('NAME', 'String', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_DB(Cl: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
cl.AddTypeS('TFieldType', '(ftUnknown, ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,'+
|
||||||
|
'ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,'+
|
||||||
|
'ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd)');
|
||||||
|
|
||||||
|
CL.AddTypeS('TDataSetState', '(dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue, dsBlockRead, dsInternalCalc, dsOpening)');
|
||||||
|
|
||||||
|
cl.addTypeS('TLocateOption','(loCaseInsensitive, loPartialKey)');
|
||||||
|
cl.addtypes('TLocateOptions','set of TLocateOption');
|
||||||
|
cl.addtypes('TUpdateStatus','(usUnmodified, usModified, usInserted, usDeleted)');
|
||||||
|
cl.addtypes('TUpdateStatusSet', 'set of TUpdateStatus');
|
||||||
|
|
||||||
|
cl.addTypeS('TPARAMTYPE', 'BYTE');
|
||||||
|
RegClassS(cl,'TComponent','TDATASET');
|
||||||
|
RegClassS(cl,'TComponent','TFIELD');
|
||||||
|
RegClassS(cl,'TComponent','TFIELDDEFS');
|
||||||
|
RegClassS(cl,'TComponent','TINDEXDEFS');
|
||||||
|
RegClassS(cl, 'TComponent', 'TObjectField');
|
||||||
|
RegClassS(cl, 'TComponent', 'TDataLink');
|
||||||
|
RegClassS(cl, 'TComponent', 'TDataSource');
|
||||||
|
RegClassS(cl, 'TComponent', 'TParam');
|
||||||
|
|
||||||
|
SIRegisterTNAMEDITEM(Cl);
|
||||||
|
Cl.addTypeS('TDEFUPDATEMETHOD', 'Procedure');
|
||||||
|
SIRegisterTDEFCOLLECTION(Cl);
|
||||||
|
cl.AddConstantN('FAHIDDENCOL','LONGINT').Value.tu32 := 1;
|
||||||
|
cl.AddConstantN('FAREADONLY','LONGINT').Value.tu32 := 2;
|
||||||
|
cl.AddConstantN('FAREQUIRED','LONGINT').Value.tu32 := 4;
|
||||||
|
cl.AddConstantN('FALINK','LONGINT').Value.tu32 := 8;
|
||||||
|
cl.AddConstantN('FAUNNAMED','LONGINT').Value.tu32 := 16;
|
||||||
|
cl.AddConstantN('FAFIXED','LONGINT').Value.tu32 := 32;
|
||||||
|
cl.addTypeS('TFIELDATTRIBUTES', 'BYTE');
|
||||||
|
SIRegisterTFIELDDEF(Cl);
|
||||||
|
SIRegisterTFIELDDEFS(Cl);
|
||||||
|
cl.AddConstantN('IXPRIMARY','LONGINT').Value.tu32 := 1;
|
||||||
|
cl.AddConstantN('IXUNIQUE','LONGINT').Value.tu32 := 2;
|
||||||
|
cl.AddConstantN('IXDESCENDING','LONGINT').Value.tu32 := 4;
|
||||||
|
cl.AddConstantN('IXCASEINSENSITIVE','LONGINT').Value.tu32 := 8;
|
||||||
|
cl.AddConstantN('IXEXPRESSION','LONGINT').Value.tu32 := 16;
|
||||||
|
cl.AddConstantN('IXNONMAINTAINED','LONGINT').Value.tu32 := 32;
|
||||||
|
cl.addTypeS('TINDEXOPTIONS', 'BYTE');
|
||||||
|
SIRegisterTINDEXDEF(Cl);
|
||||||
|
SIRegisterTINDEXDEFS(Cl);
|
||||||
|
SIRegisterTFLATLIST(Cl);
|
||||||
|
SIRegisterTFIELDDEFLIST(Cl);
|
||||||
|
SIRegisterTFIELDLIST(Cl);
|
||||||
|
cl.AddConstantN('FKDATA','LONGINT').Value.tu32 := 1;
|
||||||
|
cl.AddConstantN('FKCALCULATED','LONGINT').Value.tu32 := 2;
|
||||||
|
cl.AddConstantN('FKLOOKUP','LONGINT').Value.tu32 := 4;
|
||||||
|
cl.AddConstantN('FKINTERNALCALC','LONGINT').Value.tu32 := 8;
|
||||||
|
cl.AddConstantN('FKAGGREGATE','LONGINT').Value.tu32 := 16;
|
||||||
|
cl.addTypeS('TFIELDKINDS', 'BYTE');
|
||||||
|
SIRegisterTFIELDS(Cl);
|
||||||
|
cl.AddConstantN('PFINUPDATE','LONGINT').Value.tu32 := 1;
|
||||||
|
cl.AddConstantN('PFINWHERE','LONGINT').Value.tu32 := 2;
|
||||||
|
cl.AddConstantN('PFINKEY','LONGINT').Value.tu32 := 4;
|
||||||
|
cl.AddConstantN('PFHIDDEN','LONGINT').Value.tu32 :=8;
|
||||||
|
cl.addTypeS('TPROVIDERFLAGS', 'BYTE');
|
||||||
|
cl.addTypeS('TFIELDNOTIFYEVENT', 'Procedure ( SENDER : TFIELD)');
|
||||||
|
cl.addTypeS('TFIELDGETTEXTEVENT', 'Procedure ( SENDER : TFIELD; var TEXT : S'
|
||||||
|
+'TRING; DISPLAYTEXT : BOOLEAN)');
|
||||||
|
cl.addTypeS('TFIELDSETTEXTEVENT', 'Procedure ( SENDER : TFIELD; const TEXT :'
|
||||||
|
+' String)');
|
||||||
|
cl.addTypeS('TAUTOREFRESHFLAG', '( ARNONE, ARAUTOINC, ARDEFAULT )');
|
||||||
|
SIRegisterTLOOKUPLIST(Cl);
|
||||||
|
SIRegisterTFIELD(Cl);
|
||||||
|
SIRegisterTSTRINGFIELD(Cl);
|
||||||
|
SIRegisterTWIDESTRINGFIELD(Cl);
|
||||||
|
SIRegisterTNUMERICFIELD(Cl);
|
||||||
|
SIRegisterTINTEGERFIELD(Cl);
|
||||||
|
SIRegisterTSMALLINTFIELD(Cl);
|
||||||
|
cl.addTypeS('LARGEINT', 'INT64');
|
||||||
|
SIRegisterTLARGEINTFIELD(Cl);
|
||||||
|
SIRegisterTWORDFIELD(Cl);
|
||||||
|
SIRegisterTAUTOINCFIELD(Cl);
|
||||||
|
SIRegisterTFLOATFIELD(Cl);
|
||||||
|
SIRegisterTCURRENCYFIELD(Cl);
|
||||||
|
SIRegisterTBOOLEANFIELD(Cl);
|
||||||
|
SIRegisterTDATETIMEFIELD(Cl);
|
||||||
|
SIRegisterTDATEFIELD(Cl);
|
||||||
|
SIRegisterTTIMEFIELD(Cl);
|
||||||
|
SIRegisterTBINARYFIELD(Cl);
|
||||||
|
SIRegisterTBYTESFIELD(Cl);
|
||||||
|
SIRegisterTVARBYTESFIELD(Cl);
|
||||||
|
SIRegisterTBCDFIELD(Cl);
|
||||||
|
{$IFDEF DELPHI6UP}
|
||||||
|
SIRegisterTFMTBCDFIELD(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
cl.addTypeS('TBLOBTYPE', 'BYTE');
|
||||||
|
SIRegisterTBLOBFIELD(Cl);
|
||||||
|
SIRegisterTMEMOFIELD(Cl);
|
||||||
|
SIRegisterTGRAPHICFIELD(Cl);
|
||||||
|
SIRegisterTOBJECTFIELD(Cl);
|
||||||
|
SIRegisterTADTFIELD(Cl);
|
||||||
|
SIRegisterTARRAYFIELD(Cl);
|
||||||
|
SIRegisterTDATASETFIELD(Cl);
|
||||||
|
SIRegisterTREFERENCEFIELD(Cl);
|
||||||
|
SIRegisterTVARIANTFIELD(Cl);
|
||||||
|
SIRegisterTGUIDFIELD(Cl);
|
||||||
|
cl.addTypeS('TBLOBDATA', 'STRING');
|
||||||
|
cl.AddConstantN('PTUNKNOWN','LONGINT').Value.tu32 := 1;
|
||||||
|
cl.AddConstantN('PTINPUT','LONGINT').Value.tu32 := 2;
|
||||||
|
cl.AddConstantN('PTOUTPUT','LONGINT').Value.tu32 := 4;
|
||||||
|
cl.AddConstantN('PTINPUTOUTPUT','LONGINT').Value.tu32 := 8;
|
||||||
|
cl.AddConstantN('PTRESULT','LONGINT').Value.tu32 := 16;
|
||||||
|
RegClassS(cl,'TObject','TPARAMS');
|
||||||
|
SIRegisterTPARAM(Cl);
|
||||||
|
SIRegisterTPARAMS(Cl);
|
||||||
|
cl.addTypeS('TDATAACTION', '( DAFAIL, DAABORT, DARETRY )');
|
||||||
|
cl.addTypeS('TBLOBSTREAMMODE', '( BMREAD, BMWRITE, BMREADWRITE )');
|
||||||
|
cl.addTypeS('TDATAOPERATION', 'Procedure');
|
||||||
|
cl.addTypeS('TDATASETNOTIFYEVENT', 'Procedure ( DATASET : TDATASET)');
|
||||||
|
cl.addTypeS('TDATASETERROREVENT', 'Procedure ( DATASET : TDATASET; E : TObject'
|
||||||
|
+'; var ACTION : TDATAACTION)');
|
||||||
|
cl.addTypeS('TFILTERRECORDEVENT', 'Procedure ( DATASET : TDATASET; var ACCEP'
|
||||||
|
+'T : BOOLEAN)');
|
||||||
|
SIRegisterTDATASET(Cl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF USEIMPORTER}
|
||||||
|
initialization
|
||||||
|
CIImporter.AddCallBack(@SIRegister_DB,PT_ClassImport);
|
||||||
|
{$ENDIF}
|
||||||
|
end.
|
||||||
87
Units/PascalScript/uPSC_buttons.pas
Normal file
87
Units/PascalScript/uPSC_buttons.pas
Normal file
@ -0,0 +1,87 @@
|
|||||||
|
{ Compiletime Buttons support }
|
||||||
|
unit uPSC_buttons;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
{
|
||||||
|
Will register files from:
|
||||||
|
Buttons
|
||||||
|
|
||||||
|
Requires
|
||||||
|
STD, classes, controls and graphics and StdCtrls
|
||||||
|
}
|
||||||
|
procedure SIRegister_Buttons_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegisterTSPEEDBUTTON(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBITBTN(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegister_Buttons(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SIRegisterTSPEEDBUTTON(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGRAPHICCONTROL'), 'TSPEEDBUTTON') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ALLOWALLUP', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('GROUPINDEX', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('DOWN', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('GLYPH', 'TBITMAP', iptrw);
|
||||||
|
RegisterProperty('LAYOUT', 'TBUTTONLAYOUT', iptrw);
|
||||||
|
RegisterProperty('MARGIN', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('NUMGLYPHS', 'BYTE', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('SPACING', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTBITBTN(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TBUTTON'), 'TBITBTN') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('GLYPH', 'TBITMAP', iptrw);
|
||||||
|
RegisterProperty('KIND', 'TBITBTNKIND', iptrw);
|
||||||
|
RegisterProperty('LAYOUT', 'TBUTTONLAYOUT', iptrw);
|
||||||
|
RegisterProperty('MARGIN', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('NUMGLYPHS', 'BYTE', iptrw);
|
||||||
|
RegisterProperty('STYLE', 'TBUTTONSTYLE', iptrw);
|
||||||
|
RegisterProperty('SPACING', 'INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegister_Buttons_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
Cl.AddTypeS('TButtonLayout', '(blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom)');
|
||||||
|
Cl.AddTypeS('TButtonState', '(bsUp, bsDisabled, bsDown, bsExclusive)');
|
||||||
|
Cl.AddTypeS('TButtonStyle', '(bsAutoDetect, bsWin31, bsNew)');
|
||||||
|
Cl.AddTypeS('TBitBtnKind', '(bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose, bkAbort, bkRetry, bkIgnore, bkAll)');
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Buttons(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_Buttons_TypesAndConsts(cl);
|
||||||
|
SIRegisterTSPEEDBUTTON(cl);
|
||||||
|
SIRegisterTBITBTN(cl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
320
Units/PascalScript/uPSC_classes.pas
Normal file
320
Units/PascalScript/uPSC_classes.pas
Normal file
@ -0,0 +1,320 @@
|
|||||||
|
{ Compiletime Classes support }
|
||||||
|
unit uPSC_classes;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
{
|
||||||
|
Will register files from:
|
||||||
|
Classes (exception TPersistent and TComponent)
|
||||||
|
|
||||||
|
Register STD first
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
procedure SIRegister_Classes_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegisterTStrings(cl: TPSPascalCompiler; Streams: Boolean);
|
||||||
|
procedure SIRegisterTStringList(cl: TPSPascalCompiler);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure SIRegisterTBITS(Cl: TPSPascalCompiler);
|
||||||
|
{$ENDIF}
|
||||||
|
procedure SIRegisterTSTREAM(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTHANDLESTREAM(Cl: TPSPascalCompiler);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure SIRegisterTMEMORYSTREAM(Cl: TPSPascalCompiler);
|
||||||
|
{$ENDIF}
|
||||||
|
procedure SIRegisterTFILESTREAM(Cl: TPSPascalCompiler);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure SIRegisterTCUSTOMMEMORYSTREAM(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTRESOURCESTREAM(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPARSER(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCOLLECTIONITEM(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCOLLECTION(CL: TPSPascalCompiler);
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure SIRegisterTOWNEDCOLLECTION(CL: TPSPascalCompiler);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure SIRegister_Classes(Cl: TPSPascalCompiler; Streams: Boolean{$IFDEF D4PLUS}=True{$ENDIF});
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SIRegisterTStrings(cl: TPSPascalCompiler; Streams: Boolean); // requires TPersistent
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TPersistent'), 'TStrings') do
|
||||||
|
begin
|
||||||
|
IsAbstract := True;
|
||||||
|
RegisterMethod('function Add(S: string): Integer;');
|
||||||
|
RegisterMethod('procedure Append(S: string);');
|
||||||
|
RegisterMethod('procedure AddStrings(Strings: TStrings);');
|
||||||
|
RegisterMethod('procedure Clear;');
|
||||||
|
RegisterMethod('procedure Delete(Index: Integer);');
|
||||||
|
RegisterMethod('function IndexOf(const S: string): Integer; ');
|
||||||
|
RegisterMethod('procedure Insert(Index: Integer; S: string); ');
|
||||||
|
RegisterProperty('Count', 'Integer', iptR);
|
||||||
|
RegisterProperty('Text', 'String', iptrw);
|
||||||
|
RegisterProperty('CommaText', 'String', iptrw);
|
||||||
|
if Streams then
|
||||||
|
begin
|
||||||
|
RegisterMethod('procedure LoadFromFile(FileName: string); ');
|
||||||
|
RegisterMethod('procedure SaveToFile(FileName: string); ');
|
||||||
|
end;
|
||||||
|
RegisterProperty('Strings', 'String Integer', iptRW);
|
||||||
|
SetDefaultPropery('Strings');
|
||||||
|
RegisterProperty('Objects', 'TObject Integer', iptRW);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('procedure BeginUpdate;');
|
||||||
|
RegisterMethod('procedure EndUpdate;');
|
||||||
|
RegisterMethod('function Equals(Strings: TStrings): Boolean;');
|
||||||
|
RegisterMethod('procedure Exchange(Index1, Index2: Integer);');
|
||||||
|
RegisterMethod('function IndexOfName(Name: string): Integer;');
|
||||||
|
if Streams then
|
||||||
|
RegisterMethod('procedure LoadFromStream(Stream: TStream); ');
|
||||||
|
RegisterMethod('procedure Move(CurIndex, NewIndex: Integer); ');
|
||||||
|
if Streams then
|
||||||
|
RegisterMethod('procedure SaveToStream(Stream: TStream); ');
|
||||||
|
RegisterMethod('procedure SetText(Text: PChar); ');
|
||||||
|
RegisterProperty('Names', 'String Integer', iptr);
|
||||||
|
RegisterProperty('Values', 'String String', iptRW);
|
||||||
|
RegisterMethod('function AddObject(S:String;AObject:TObject):integer');
|
||||||
|
RegisterMethod('function GetText:PChar');
|
||||||
|
RegisterMethod('function IndexofObject(AObject:tObject):Integer');
|
||||||
|
RegisterMethod('procedure InsertObject(Index:Integer;S:String;AObject:TObject)');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTSTRINGLIST(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TStrings'), 'TStringList') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('function Find(S:String;var Index:Integer):Boolean');
|
||||||
|
RegisterMethod('procedure Sort');
|
||||||
|
RegisterProperty('Duplicates', 'TDuplicates', iptrw);
|
||||||
|
RegisterProperty('Sorted', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('OnChange', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('OnChanging', 'TNotifyEvent', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure SIRegisterTBITS(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TObject'), 'TBits') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('function OpenBit:Integer');
|
||||||
|
RegisterProperty('Bits', 'Boolean Integer', iptrw);
|
||||||
|
RegisterProperty('Size', 'Integer', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure SIRegisterTSTREAM(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TOBJECT'), 'TStream') do
|
||||||
|
begin
|
||||||
|
IsAbstract := True;
|
||||||
|
RegisterMethod('function Read(Buffer:String;Count:LongInt):LongInt');
|
||||||
|
RegisterMethod('function Write(Buffer:String;Count:LongInt):LongInt');
|
||||||
|
RegisterMethod('function Seek(Offset:LongInt;Origin:Word):LongInt');
|
||||||
|
RegisterMethod('procedure ReadBuffer(Buffer:String;Count:LongInt)');
|
||||||
|
RegisterMethod('procedure WriteBuffer(Buffer:String;Count:LongInt)');
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
RegisterMethod('function CopyFrom(Source:TStream;Count:Int64):LongInt');
|
||||||
|
{$ELSE}
|
||||||
|
RegisterMethod('function CopyFrom(Source:TStream;Count:Integer):LongInt');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('Position', 'LongInt', iptrw);
|
||||||
|
RegisterProperty('Size', 'LongInt', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTHANDLESTREAM(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TSTREAM'), 'THandleStream') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor Create(AHandle:Integer)');
|
||||||
|
RegisterProperty('Handle', 'Integer', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure SIRegisterTMEMORYSTREAM(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMMEMORYSTREAM'), 'TMemoryStream') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('procedure Clear');
|
||||||
|
RegisterMethod('procedure LoadFromStream(Stream:TStream)');
|
||||||
|
RegisterMethod('procedure LoadFromFile(FileName:String)');
|
||||||
|
RegisterMethod('procedure SetSize(NewSize:LongInt)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure SIRegisterTFILESTREAM(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('THandleStream'), 'TFileStream') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor Create(FileName:String;Mode:Word)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure SIRegisterTCUSTOMMEMORYSTREAM(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TSTREAM'), 'TCustomMemoryStream') do
|
||||||
|
begin
|
||||||
|
IsAbstract := True;
|
||||||
|
RegisterMethod('procedure SaveToStream(Stream:TStream)');
|
||||||
|
RegisterMethod('procedure SaveToFile(FileName:String)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTRESOURCESTREAM(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMMEMORYSTREAM'), 'TResourceStream') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor Create(Instance:THandle;ResName:String;ResType:PChar)');
|
||||||
|
RegisterMethod('constructor CreateFromId(Instance:THandle;ResId:Integer;ResType:PChar)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPARSER(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TOBJECT'), 'TParser') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor Create(Stream:TStream)');
|
||||||
|
RegisterMethod('procedure CheckToken(t:char)');
|
||||||
|
RegisterMethod('procedure CheckTokenSymbol(s:string)');
|
||||||
|
RegisterMethod('procedure Error(Ident:Integer)');
|
||||||
|
RegisterMethod('procedure ErrorStr(Message:String)');
|
||||||
|
RegisterMethod('procedure HexToBinary(Stream:TStream)');
|
||||||
|
RegisterMethod('function NextToken:Char');
|
||||||
|
RegisterMethod('function SourcePos:LongInt');
|
||||||
|
RegisterMethod('function TokenComponentIdent:String');
|
||||||
|
RegisterMethod('function TokenFloat:Extended');
|
||||||
|
RegisterMethod('function TokenInt:LongInt');
|
||||||
|
RegisterMethod('function TokenString:String');
|
||||||
|
RegisterMethod('function TokenSymbolIs(S:String):Boolean');
|
||||||
|
RegisterProperty('SourceLine', 'Integer', iptr);
|
||||||
|
RegisterProperty('Token', 'Char', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTCOLLECTIONITEM(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
if cl.FindClass('TCOLLECTION') = nil then cl.AddClassN(cl.FindClass('TPERSISTENT'), 'TCollection');
|
||||||
|
With cl.AddClassN(cl.FindClass('TPERSISTENT'),'TCollectionItem') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor Create( Collection : TCollection)');
|
||||||
|
RegisterProperty('Collection', 'TCollection', iptrw);
|
||||||
|
{$IFDEF DELPHI3UP} RegisterProperty('Id', 'Integer', iptr); {$ENDIF}
|
||||||
|
RegisterProperty('Index', 'Integer', iptrw);
|
||||||
|
{$IFDEF DELPHI3UP} RegisterProperty('DisplayName', 'String', iptrw); {$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTCOLLECTION(CL: TPSPascalCompiler);
|
||||||
|
var
|
||||||
|
cr: TPSCompileTimeClass;
|
||||||
|
Begin
|
||||||
|
cr := CL.FindClass('TCOLLECTION');
|
||||||
|
if cr = nil then cr := cl.AddClassN(cl.FindClass('TPERSISTENT'), 'TCollection');
|
||||||
|
With cr do
|
||||||
|
begin
|
||||||
|
// RegisterMethod('constructor Create( ItemClass : TCollectionItemClass)');
|
||||||
|
{$IFDEF DELPHI3UP} RegisterMethod('function Owner : TPersistent'); {$ENDIF}
|
||||||
|
RegisterMethod('function Add : TCollectionItem');
|
||||||
|
RegisterMethod('procedure BeginUpdate');
|
||||||
|
RegisterMethod('procedure Clear');
|
||||||
|
{$IFDEF DELPHI5UP} RegisterMethod('procedure Delete( Index : Integer)'); {$ENDIF}
|
||||||
|
RegisterMethod('procedure EndUpdate');
|
||||||
|
{$IFDEF DELPHI3UP} RegisterMethod('function FindItemId( Id : Integer) : TCollectionItem'); {$ENDIF}
|
||||||
|
{$IFDEF DELPHI3UP} RegisterMethod('function Insert( Index : Integer) : TCollectionItem'); {$ENDIF}
|
||||||
|
RegisterProperty('Count', 'Integer', iptr);
|
||||||
|
{$IFDEF DELPHI3UP} RegisterProperty('ItemClass', 'TCollectionItemClass', iptr); {$ENDIF}
|
||||||
|
RegisterProperty('Items', 'TCollectionItem Integer', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure SIRegisterTOWNEDCOLLECTION(CL: TPSPascalCompiler);
|
||||||
|
Begin
|
||||||
|
With Cl.AddClassN(cl.FindClass('TCOLLECTION'),'TOwnedCollection') do
|
||||||
|
begin
|
||||||
|
// RegisterMethod('Constructor CREATE( AOWNER : TPERSISTENT; ITEMCLASS : TCOLLECTIONITEMCLASS)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure SIRegister_Classes_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
cl.AddConstantN('soFromBeginning', 'Longint').Value.ts32 := 0;
|
||||||
|
cl.AddConstantN('soFromCurrent', 'Longint').Value.ts32 := 1;
|
||||||
|
cl.AddConstantN('soFromEnd', 'Longint').Value.ts32 := 2;
|
||||||
|
cl.AddConstantN('toEOF', 'Char').SetString(#0);
|
||||||
|
cl.AddConstantN('toSymbol', 'Char').SetString(#1);
|
||||||
|
cl.AddConstantN('toString', 'Char').SetString(#2);
|
||||||
|
cl.AddConstantN('toInteger', 'Char').SetString(#3);
|
||||||
|
cl.AddConstantN('toFloat', 'Char').SetString(#4);
|
||||||
|
cl.AddConstantN('fmCreate', 'Longint').Value.ts32 := $FFFF;
|
||||||
|
cl.AddConstantN('fmOpenRead', 'Longint').Value.ts32 := 0;
|
||||||
|
cl.AddConstantN('fmOpenWrite', 'Longint').Value.ts32 := 1;
|
||||||
|
cl.AddConstantN('fmOpenReadWrite', 'Longint').Value.ts32 := 2;
|
||||||
|
cl.AddConstantN('fmShareCompat', 'Longint').Value.ts32 := 0;
|
||||||
|
cl.AddConstantN('fmShareExclusive', 'Longint').Value.ts32 := $10;
|
||||||
|
cl.AddConstantN('fmShareDenyWrite', 'Longint').Value.ts32 := $20;
|
||||||
|
cl.AddConstantN('fmShareDenyRead', 'Longint').Value.ts32 := $30;
|
||||||
|
cl.AddConstantN('fmShareDenyNone', 'Longint').Value.ts32 := $40;
|
||||||
|
cl.AddConstantN('SecsPerDay', 'Longint').Value.ts32 := 86400;
|
||||||
|
cl.AddConstantN('MSecPerDay', 'Longint').Value.ts32 := 86400000;
|
||||||
|
cl.AddConstantN('DateDelta', 'Longint').Value.ts32 := 693594;
|
||||||
|
cl.AddTypeS('TAlignment', '(taLeftJustify, taRightJustify, taCenter)');
|
||||||
|
cl.AddTypeS('THelpEvent', 'function (Command: Word; Data: Longint; var CallHelp: Boolean): Boolean');
|
||||||
|
cl.AddTypeS('TGetStrProc', 'procedure(const S: string)');
|
||||||
|
cl.AddTypeS('TDuplicates', '(dupIgnore, dupAccept, dupError)');
|
||||||
|
cl.AddTypeS('TOperation', '(opInsert, opRemove)');
|
||||||
|
cl.AddTypeS('THANDLE', 'Longint');
|
||||||
|
|
||||||
|
cl.AddTypeS('TNotifyEvent', 'procedure (Sender: TObject)');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Classes(Cl: TPSPascalCompiler; Streams: Boolean);
|
||||||
|
begin
|
||||||
|
SIRegister_Classes_TypesAndConsts(Cl);
|
||||||
|
if Streams then
|
||||||
|
SIRegisterTSTREAM(Cl);
|
||||||
|
SIRegisterTStrings(cl, Streams);
|
||||||
|
SIRegisterTStringList(cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTBITS(cl);
|
||||||
|
{$ENDIF}
|
||||||
|
if Streams then
|
||||||
|
begin
|
||||||
|
SIRegisterTHANDLESTREAM(Cl);
|
||||||
|
SIRegisterTFILESTREAM(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTCUSTOMMEMORYSTREAM(Cl);
|
||||||
|
SIRegisterTMEMORYSTREAM(Cl);
|
||||||
|
SIRegisterTRESOURCESTREAM(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTPARSER(Cl);
|
||||||
|
SIRegisterTCOLLECTIONITEM(Cl);
|
||||||
|
SIRegisterTCOLLECTION(Cl);
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
SIRegisterTOWNEDCOLLECTION(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
28
Units/PascalScript/uPSC_comobj.pas
Normal file
28
Units/PascalScript/uPSC_comobj.pas
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
{ compiletime ComObj support }
|
||||||
|
unit uPSC_comobj;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
{
|
||||||
|
|
||||||
|
Will register:
|
||||||
|
|
||||||
|
function CreateOleObject(const ClassName: String): IDispatch;
|
||||||
|
function GetActiveOleObject(const ClassName: String): IDispatch;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
procedure SIRegister_ComObj(cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SIRegister_ComObj(cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
cl.AddDelphiFunction('function CreateOleObject(const ClassName: String): IDispatch;');
|
||||||
|
cl.AddDelphiFunction('function GetActiveOleObject(const ClassName: String): IDispatch;');
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
236
Units/PascalScript/uPSC_controls.pas
Normal file
236
Units/PascalScript/uPSC_controls.pas
Normal file
@ -0,0 +1,236 @@
|
|||||||
|
{ Compiletime Controls support }
|
||||||
|
unit uPSC_controls;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
{
|
||||||
|
Will register files from:
|
||||||
|
Controls
|
||||||
|
|
||||||
|
Register the STD, Classes (at least the types&consts) and Graphics libraries first
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
procedure SIRegister_Controls_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegisterTControl(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTWinControl(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTGraphicControl(cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCustomControl(cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTDragObject(cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegister_Controls(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SIRegisterTControl(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TComponent'), 'TCONTROL') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor Create(AOwner: TComponent);');
|
||||||
|
RegisterMethod('procedure BringToFront;');
|
||||||
|
RegisterMethod('procedure Hide;');
|
||||||
|
RegisterMethod('procedure Invalidate;virtual;');
|
||||||
|
RegisterMethod('procedure refresh;');
|
||||||
|
RegisterMethod('procedure Repaint;virtual;');
|
||||||
|
RegisterMethod('procedure SendToBack;');
|
||||||
|
RegisterMethod('procedure Show;');
|
||||||
|
RegisterMethod('procedure Update;virtual;');
|
||||||
|
RegisterMethod('procedure SetBounds(x,y,w,h: Integer);virtual;');
|
||||||
|
RegisterProperty('Left', 'Integer', iptRW);
|
||||||
|
RegisterProperty('Top', 'Integer', iptRW);
|
||||||
|
RegisterProperty('Width', 'Integer', iptRW);
|
||||||
|
RegisterProperty('Height', 'Integer', iptRW);
|
||||||
|
RegisterProperty('Hint', 'String', iptRW);
|
||||||
|
RegisterProperty('Align', 'TAlign', iptRW);
|
||||||
|
RegisterProperty('ClientHeight', 'Longint', iptRW);
|
||||||
|
RegisterProperty('ClientWidth', 'Longint', iptRW);
|
||||||
|
RegisterProperty('ShowHint', 'Boolean', iptRW);
|
||||||
|
RegisterProperty('Visible', 'Boolean', iptRW);
|
||||||
|
RegisterProperty('ENABLED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('CURSOR', 'TCURSOR', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('function Dragging: Boolean;');
|
||||||
|
RegisterMethod('function HasParent: Boolean');
|
||||||
|
RegisterMethod('procedure BEGINDRAG(IMMEDIATE:BOOLEAN)');
|
||||||
|
RegisterMethod('function CLIENTTOSCREEN(POINT:TPOINT):TPOINT');
|
||||||
|
RegisterMethod('procedure ENDDRAG(DROP:BOOLEAN)');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod('function GETTEXTBUF(BUFFER:PCHAR;BUFSIZE:INTEGER):INTEGER');
|
||||||
|
RegisterMethod('function GETTEXTLEN:INTEGER');
|
||||||
|
RegisterMethod('procedure SETTEXTBUF(BUFFER:PCHAR)');
|
||||||
|
RegisterMethod('function PERFORM(MSG:CARDINAL;WPARAM,LPARAM:LONGINT):LONGINT');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod('function SCREENTOCLIENT(POINT:TPOINT):TPOINT');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTWinControl(Cl: TPSPascalCompiler); // requires TControl
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TControl'), 'TWINCONTROL') do
|
||||||
|
begin
|
||||||
|
|
||||||
|
with Cl.FindClass('TControl') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('Parent', 'TWinControl', iptRW);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterProperty('Handle', 'Longint', iptR);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('Showing', 'Boolean', iptR);
|
||||||
|
RegisterProperty('TabOrder', 'Integer', iptRW);
|
||||||
|
RegisterProperty('TabStop', 'Boolean', iptRW);
|
||||||
|
RegisterMethod('function CANFOCUS:BOOLEAN');
|
||||||
|
RegisterMethod('function FOCUSED:BOOLEAN');
|
||||||
|
RegisterProperty('CONTROLS', 'TCONTROL INTEGER', iptr);
|
||||||
|
RegisterProperty('CONTROLCOUNT', 'INTEGER', iptr);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('function HandleAllocated: Boolean;');
|
||||||
|
RegisterMethod('procedure HandleNeeded;');
|
||||||
|
RegisterMethod('procedure EnableAlign;');
|
||||||
|
RegisterMethod('procedure RemoveControl(AControl: TControl);');
|
||||||
|
RegisterMethod('procedure InsertControl(AControl: TControl);');
|
||||||
|
RegisterMethod('procedure Realign;');
|
||||||
|
RegisterMethod('procedure ScaleBy(M, D: Integer);');
|
||||||
|
RegisterMethod('procedure ScrollBy(DeltaX, DeltaY: Integer);');
|
||||||
|
RegisterMethod('procedure SetFocus; virtual;');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod('procedure PAINTTO(DC:Longint;X,Y:INTEGER)');
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
RegisterMethod('function CONTAINSCONTROL(CONTROL:TCONTROL):BOOLEAN');
|
||||||
|
RegisterMethod('procedure DISABLEALIGN');
|
||||||
|
RegisterMethod('procedure UPDATECONTROLSTATE');
|
||||||
|
|
||||||
|
RegisterProperty('BRUSH', 'TBRUSH', iptr);
|
||||||
|
RegisterProperty('HELPCONTEXT', 'LONGINT', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
procedure SIRegisterTGraphicControl(cl: TPSPascalCompiler); // requires TControl
|
||||||
|
begin
|
||||||
|
Cl.AddClassN(cl.FindClass('TControl'), 'TGRAPHICCONTROL');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTCustomControl(cl: TPSPascalCompiler); // requires TWinControl
|
||||||
|
begin
|
||||||
|
Cl.AddClassN(cl.FindClass('TWinControl'), 'TCUSTOMCONTROL');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Controls_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
Cl.addTypeS('TEShiftState','(ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble)');
|
||||||
|
{$ELSE}
|
||||||
|
Cl.addTypeS('TEShiftState','(ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble,' +
|
||||||
|
'ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum,ssScroll,ssTriple,ssQuad)');
|
||||||
|
{$ENDIF}
|
||||||
|
Cl.addTypeS('TShiftState','set of TEShiftState');
|
||||||
|
cl.AddTypeS('TMouseButton', '(mbLeft, mbRight, mbMiddle)');
|
||||||
|
cl.AddTypeS('TDragMode', '(dmManual, dmAutomatic)');
|
||||||
|
cl.AddTypeS('TDragState', '(dsDragEnter, dsDragLeave, dsDragMove)');
|
||||||
|
cl.AddTypeS('TDragKind', '(dkDrag, dkDock)');
|
||||||
|
cl.AddTypeS('TMouseEvent', 'procedure (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);');
|
||||||
|
cl.AddTypeS('TMouseMoveEvent', 'procedure(Sender: TObject; Shift: TShiftState; X, Y: Integer);');
|
||||||
|
cl.AddTypeS('TKeyEvent', 'procedure (Sender: TObject; var Key: Word; Shift: TShiftState);');
|
||||||
|
cl.AddTypeS('TKeyPressEvent', 'procedure(Sender: TObject; var Key: Char);');
|
||||||
|
cl.AddTypeS('TDragOverEvent', 'procedure(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean)');
|
||||||
|
cl.AddTypeS('TDragDropEvent', 'procedure(Sender, Source: TObject;X, Y: Integer)');
|
||||||
|
cl.AddTypeS('HWND', 'Longint');
|
||||||
|
|
||||||
|
cl.AddTypeS('TEndDragEvent', 'procedure(Sender, Target: TObject; X, Y: Integer)');
|
||||||
|
|
||||||
|
cl.addTypeS('TAlign', '(alNone, alTop, alBottom, alLeft, alRight, alClient)');
|
||||||
|
|
||||||
|
cl.addTypeS('TAnchorKind', '(akTop, akLeft, akRight, akBottom)');
|
||||||
|
cl.addTypeS('TAnchors','set of TAnchorKind');
|
||||||
|
cl.AddTypeS('TModalResult', 'Integer');
|
||||||
|
cl.AddTypeS('TCursor', 'Integer');
|
||||||
|
cl.AddTypeS('TPoint', 'record x,y: Longint; end;');
|
||||||
|
|
||||||
|
cl.AddConstantN('mrNone', 'Integer').Value.ts32 := 0;
|
||||||
|
cl.AddConstantN('mrOk', 'Integer').Value.ts32 := 1;
|
||||||
|
cl.AddConstantN('mrCancel', 'Integer').Value.ts32 := 2;
|
||||||
|
cl.AddConstantN('mrAbort', 'Integer').Value.ts32 := 3;
|
||||||
|
cl.AddConstantN('mrRetry', 'Integer').Value.ts32 := 4;
|
||||||
|
cl.AddConstantN('mrIgnore', 'Integer').Value.ts32 := 5;
|
||||||
|
cl.AddConstantN('mrYes', 'Integer').Value.ts32 := 6;
|
||||||
|
cl.AddConstantN('mrNo', 'Integer').Value.ts32 := 7;
|
||||||
|
cl.AddConstantN('mrAll', 'Integer').Value.ts32 := 8;
|
||||||
|
cl.AddConstantN('mrNoToAll', 'Integer').Value.ts32 := 9;
|
||||||
|
cl.AddConstantN('mrYesToAll', 'Integer').Value.ts32 := 10;
|
||||||
|
cl.AddConstantN('crDefault', 'Integer').Value.ts32 := 0;
|
||||||
|
cl.AddConstantN('crNone', 'Integer').Value.ts32 := -1;
|
||||||
|
cl.AddConstantN('crArrow', 'Integer').Value.ts32 := -2;
|
||||||
|
cl.AddConstantN('crCross', 'Integer').Value.ts32 := -3;
|
||||||
|
cl.AddConstantN('crIBeam', 'Integer').Value.ts32 := -4;
|
||||||
|
cl.AddConstantN('crSizeNESW', 'Integer').Value.ts32 := -6;
|
||||||
|
cl.AddConstantN('crSizeNS', 'Integer').Value.ts32 := -7;
|
||||||
|
cl.AddConstantN('crSizeNWSE', 'Integer').Value.ts32 := -8;
|
||||||
|
cl.AddConstantN('crSizeWE', 'Integer').Value.ts32 := -9;
|
||||||
|
cl.AddConstantN('crUpArrow', 'Integer').Value.ts32 := -10;
|
||||||
|
cl.AddConstantN('crHourGlass', 'Integer').Value.ts32 := -11;
|
||||||
|
cl.AddConstantN('crDrag', 'Integer').Value.ts32 := -12;
|
||||||
|
cl.AddConstantN('crNoDrop', 'Integer').Value.ts32 := -13;
|
||||||
|
cl.AddConstantN('crHSplit', 'Integer').Value.ts32 := -14;
|
||||||
|
cl.AddConstantN('crVSplit', 'Integer').Value.ts32 := -15;
|
||||||
|
cl.AddConstantN('crMultiDrag', 'Integer').Value.ts32 := -16;
|
||||||
|
cl.AddConstantN('crSQLWait', 'Integer').Value.ts32 := -17;
|
||||||
|
cl.AddConstantN('crNo', 'Integer').Value.ts32 := -18;
|
||||||
|
cl.AddConstantN('crAppStart', 'Integer').Value.ts32 := -19;
|
||||||
|
cl.AddConstantN('crHelp', 'Integer').Value.ts32 := -20;
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
cl.AddConstantN('crHandPoint', 'Integer').Value.ts32 := -21;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
cl.AddConstantN('crSizeAll', 'Integer').Value.ts32 := -22;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTDragObject(cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with CL.AddClassN(CL.FindClass('TObject'),'TDragObject') do
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
RegisterMethod('Procedure Assign( Source : TDragObject)');
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod('Function GetName : String');
|
||||||
|
RegisterMethod('Function Instance : Longint');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod('Procedure HideDragImage');
|
||||||
|
RegisterMethod('Procedure ShowDragImage');
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
RegisterProperty('Cancelling', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DragHandle', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DragPos', 'TPoint', iptrw);
|
||||||
|
RegisterProperty('DragTargetPos', 'TPoint', iptrw);
|
||||||
|
RegisterProperty('MouseDeltaX', 'Double', iptr);
|
||||||
|
RegisterProperty('MouseDeltaY', 'Double', iptr);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
Cl.AddTypeS('TStartDragEvent', 'procedure (Sender: TObject; var DragObject: TDragObject)');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Controls(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_Controls_TypesAndConsts(cl);
|
||||||
|
SIRegisterTDragObject(cl);
|
||||||
|
SIRegisterTControl(Cl);
|
||||||
|
SIRegisterTWinControl(Cl);
|
||||||
|
SIRegisterTGraphicControl(cl);
|
||||||
|
SIRegisterTCustomControl(cl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
end.
|
||||||
34
Units/PascalScript/uPSC_dateutils.pas
Normal file
34
Units/PascalScript/uPSC_dateutils.pas
Normal file
@ -0,0 +1,34 @@
|
|||||||
|
{ Compile time Date Time library }
|
||||||
|
unit uPSC_dateutils;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils, uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RegisterDateTimeLibrary_C(S: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure RegisterDatetimeLibrary_C(S: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
s.AddType('TDateTime', btDouble).ExportName := True;
|
||||||
|
s.AddDelphiFunction('function EncodeDate(Year, Month, Day: Word): TDateTime;');
|
||||||
|
s.AddDelphiFunction('function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;');
|
||||||
|
s.AddDelphiFunction('function TryEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;');
|
||||||
|
s.AddDelphiFunction('function TryEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;');
|
||||||
|
s.AddDelphiFunction('procedure DecodeDate(const DateTime: TDateTime; var Year, Month, Day: Word);');
|
||||||
|
s.AddDelphiFunction('procedure DecodeTime(const DateTime: TDateTime; var Hour, Min, Sec, MSec: Word);');
|
||||||
|
s.AddDelphiFunction('function DayOfWeek(const DateTime: TDateTime): Word;');
|
||||||
|
s.AddDelphiFunction('function Date: TDateTime;');
|
||||||
|
s.AddDelphiFunction('function Time: TDateTime;');
|
||||||
|
s.AddDelphiFunction('function Now: TDateTime;');
|
||||||
|
s.AddDelphiFunction('function DateTimeToUnix(D: TDateTime): Int64;');
|
||||||
|
s.AddDelphiFunction('function UnixToDateTime(U: Int64): TDateTime;');
|
||||||
|
|
||||||
|
s.AddDelphiFunction('function DateToStr(D: TDateTime): String;');
|
||||||
|
s.AddDelphiFunction('function StrToDate(const s: String): TDateTime;');
|
||||||
|
s.AddDelphiFunction('function FormatDateTime(const fmt: String; D: TDateTime): String;');
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
158
Units/PascalScript/uPSC_dll.pas
Normal file
158
Units/PascalScript/uPSC_dll.pas
Normal file
@ -0,0 +1,158 @@
|
|||||||
|
{ Compiletime DLL importing support }
|
||||||
|
unit uPSC_dll;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
{
|
||||||
|
|
||||||
|
Function FindWindow(c1, c2: PChar): Cardinal; external 'FindWindow@user32.dll stdcall';
|
||||||
|
|
||||||
|
}
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP }
|
||||||
|
resourceString
|
||||||
|
{$ELSE }
|
||||||
|
const
|
||||||
|
{$ENDIF }
|
||||||
|
|
||||||
|
RPS_Invalid_External = 'Invalid External';
|
||||||
|
RPS_InvalidCallingConvention = 'Invalid Calling Convention';
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const OriginalName, FExternal: tbtstring): TPSRegProc;
|
||||||
|
type
|
||||||
|
|
||||||
|
TDllCallingConvention = (clRegister
|
||||||
|
, clPascal
|
||||||
|
, ClCdecl
|
||||||
|
, ClStdCall
|
||||||
|
);
|
||||||
|
|
||||||
|
var
|
||||||
|
DefaultCC: TDllCallingConvention;
|
||||||
|
|
||||||
|
procedure RegisterDll_Compiletime(cs: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function rpos(ch: tbtchar; const s: tbtstring): Longint;
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
begin
|
||||||
|
for i := length(s) downto 1 do
|
||||||
|
if s[i] = ch then begin Result := i; exit; end;
|
||||||
|
result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RemoveQuotes(s: tbtstring): tbtstring;
|
||||||
|
begin
|
||||||
|
result := s;
|
||||||
|
if result = '' then exit;
|
||||||
|
if Result[1] = '"' then delete(result ,1,1);
|
||||||
|
if (Result <> '') and (Result[Length(result)] = '"') then delete(result, length(result), 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const OriginalName, FExternal: tbtstring): TPSRegProc;
|
||||||
|
var
|
||||||
|
FuncName,
|
||||||
|
Name,
|
||||||
|
FuncCC, s, s2: AnsiString;
|
||||||
|
CC: TDllCallingConvention;
|
||||||
|
DelayLoad, LoadWithAlteredSearchPath: Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Name := FastUpperCase(OriginalName);
|
||||||
|
DelayLoad := False;
|
||||||
|
LoadWithAlteredSearchPath := false;
|
||||||
|
FuncCC := FExternal;
|
||||||
|
|
||||||
|
if (pos(tbtChar('@'), FuncCC) = 0) then
|
||||||
|
begin
|
||||||
|
Sender.MakeError('', ecCustomError, tbtString(RPS_Invalid_External));
|
||||||
|
Result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
FuncName := copy(FuncCC, 1, rpos('@', FuncCC)-1)+#0;
|
||||||
|
delete(FuncCc, 1, length(FuncName));
|
||||||
|
if pos(tbtchar(' '), Funccc) <> 0 then
|
||||||
|
begin
|
||||||
|
if FuncCC[1] = '"' then
|
||||||
|
begin
|
||||||
|
Delete(FuncCC, 1, 1);
|
||||||
|
FuncName := RemoveQuotes(copy(FuncCC, 1, pos(tbtchar('"'), FuncCC)-1))+#0+FuncName;
|
||||||
|
Delete(FuncCC,1, pos(tbtchar('"'), FuncCC));
|
||||||
|
if (FuncCC <> '') and( FuncCC[1] = ' ') then delete(FuncCC,1,1);
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
FuncName := copy(FuncCc, 1, pos(tbtchar(' '),FuncCC)-1)+#0+FuncName;
|
||||||
|
Delete(FuncCC, 1, pos(tbtchar(' '), FuncCC));
|
||||||
|
end;
|
||||||
|
if pos(tbtchar(' '), FuncCC) > 0 then
|
||||||
|
begin
|
||||||
|
s := Copy(FuncCC, pos(tbtchar(' '), Funccc)+1, MaxInt);
|
||||||
|
FuncCC := FastUpperCase(Copy(FuncCC, 1, pos(tbtchar(' '), FuncCC)-1));
|
||||||
|
Delete(FuncCC, pos(tbtchar(' '), Funccc), MaxInt);
|
||||||
|
repeat
|
||||||
|
if pos(tbtchar(' '), s) > 0 then begin
|
||||||
|
s2 := Copy(s, 1, pos(tbtchar(' '), s)-1);
|
||||||
|
delete(s, 1, pos(tbtchar(' '), s));
|
||||||
|
end else begin
|
||||||
|
s2 := s;
|
||||||
|
s := '';
|
||||||
|
end;
|
||||||
|
if FastUppercase(s2) = 'DELAYLOAD' then
|
||||||
|
DelayLoad := True
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
else
|
||||||
|
if FastUppercase(s2) = 'LOADWITHALTEREDSEARCHPATH' then
|
||||||
|
LoadWithAlteredSearchPath := True
|
||||||
|
{$ENDIF}
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Sender.MakeError('', ecCustomError, 'Invalid External');
|
||||||
|
Result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
until s = '';
|
||||||
|
|
||||||
|
end else
|
||||||
|
FuncCC := FastUpperCase(FuncCC);
|
||||||
|
if FuncCC = 'STDCALL' then cc := ClStdCall else
|
||||||
|
if FuncCC = 'CDECL' then cc := ClCdecl else
|
||||||
|
if FuncCC = 'REGISTER' then cc := clRegister else
|
||||||
|
if FuncCC = 'PASCAL' then cc := clPascal else
|
||||||
|
begin
|
||||||
|
Sender.MakeError('', ecCustomError, tbtstring(RPS_InvalidCallingConvention));
|
||||||
|
Result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
FuncName := RemoveQuotes(FuncCC)+#0+FuncName;
|
||||||
|
FuncCC := '';
|
||||||
|
cc := DefaultCC;
|
||||||
|
end;
|
||||||
|
FuncName := 'dll:'+FuncName+tbtchar(cc)+tbtchar(bytebool(DelayLoad)) +tbtchar(bytebool(LoadWithAlteredSearchPath))+ declToBits(Decl);
|
||||||
|
Result := TPSRegProc.Create;
|
||||||
|
Result.ImportDecl := FuncName;
|
||||||
|
Result.Decl.Assign(Decl);
|
||||||
|
Result.Name := Name;
|
||||||
|
Result.OrgName := OriginalName;
|
||||||
|
Result.ExportName := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RegisterDll_Compiletime(cs: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
cs.OnExternalProc := DllExternalProc;
|
||||||
|
cs.AddFunction('procedure UnloadDll(s: string)');
|
||||||
|
cs.AddFunction('function DLLGetLastError: Longint');
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DefaultCc := clRegister;
|
||||||
|
end.
|
||||||
|
|
||||||
327
Units/PascalScript/uPSC_extctrls.pas
Normal file
327
Units/PascalScript/uPSC_extctrls.pas
Normal file
@ -0,0 +1,327 @@
|
|||||||
|
{ Compiletime Extctrls support }
|
||||||
|
unit uPSC_extctrls;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
(*
|
||||||
|
Will register files from:
|
||||||
|
ExtCtrls
|
||||||
|
|
||||||
|
Requires:
|
||||||
|
STD, classes, controls, graphics {$IFNDEF PS_MINIVCL}, stdctrls {$ENDIF}
|
||||||
|
*)
|
||||||
|
|
||||||
|
procedure SIRegister_ExtCtrls_TypesAndConsts(cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegisterTSHAPE(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTIMAGE(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPAINTBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBEVEL(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTTIMER(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCUSTOMPANEL(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPANEL(Cl: TPSPascalCompiler);
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure SIRegisterTPAGE(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTNOTEBOOK(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTHEADER(Cl: TPSPascalCompiler);
|
||||||
|
{$ENDIF}
|
||||||
|
procedure SIRegisterTCUSTOMRADIOGROUP(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTRADIOGROUP(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegister_ExtCtrls(cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
procedure SIRegisterTSHAPE(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGRAPHICCONTROL'), 'TSHAPE') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('BRUSH', 'TBRUSH', iptrw);
|
||||||
|
RegisterProperty('PEN', 'TPEN', iptrw);
|
||||||
|
RegisterProperty('SHAPE', 'TSHAPETYPE', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('procedure STYLECHANGED(SENDER:TOBJECT)');
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTIMAGE(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGRAPHICCONTROL'), 'TIMAGE') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('CANVAS', 'TCANVAS', iptr);
|
||||||
|
RegisterProperty('AUTOSIZE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('CENTER', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('PICTURE', 'TPICTURE', iptrw);
|
||||||
|
RegisterProperty('STRETCH', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPAINTBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGRAPHICCONTROL'), 'TPAINTBOX') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('CANVAS', 'TCanvas', iptr);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONPAINT', 'TNOTIFYEVENT', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTBEVEL(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGRAPHICCONTROL'), 'TBEVEL') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('SHAPE', 'TBEVELSHAPE', iptrw);
|
||||||
|
RegisterProperty('STYLE', 'TBEVELSTYLE', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTTIMER(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCOMPONENT'), 'TTIMER') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ENABLED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('INTERVAL', 'CARDINAL', iptrw);
|
||||||
|
RegisterProperty('ONTIMER', 'TNOTIFYEVENT', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMPANEL(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TCUSTOMPANEL');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPANEL(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMPANEL'), 'TPANEL') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ALIGNMENT', 'TAlignment', iptrw);
|
||||||
|
RegisterProperty('BEVELINNER', 'TPanelBevel', iptrw);
|
||||||
|
RegisterProperty('BEVELOUTER', 'TPanelBevel', iptrw);
|
||||||
|
RegisterProperty('BEVELWIDTH', 'TBevelWidth', iptrw);
|
||||||
|
RegisterProperty('BORDERWIDTH', 'TBorderWidth', iptrw);
|
||||||
|
RegisterProperty('BORDERSTYLE', 'TBorderStyle', iptrw);
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('LOCKED', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONRESIZE', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure SIRegisterTPAGE(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TPAGE') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
procedure SIRegisterTNOTEBOOK(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TNOTEBOOK') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ACTIVEPAGE', 'String', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('PAGEINDEX', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('PAGES', 'TSTRINGS', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONPAGECHANGED', 'TNOTIFYEVENT', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTHEADER(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'THEADER') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('SECTIONWIDTH', 'INTEGER INTEGER', iptrw);
|
||||||
|
RegisterProperty('ALLOWRESIZE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('BORDERSTYLE', 'TBORDERSTYLE', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('SECTIONS', 'TSTRINGS', iptrw);
|
||||||
|
RegisterProperty('ONSIZING', 'TSECTIONEVENT', iptrw);
|
||||||
|
RegisterProperty('ONSIZED', 'TSECTIONEVENT', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMRADIOGROUP(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
Cl.AddClassN(cl.FindClass('TCUSTOMGROUPBOX'), 'TCUSTOMRADIOGROUP');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTRADIOGROUP(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMRADIOGROUP'), 'TRADIOGROUP') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('COLUMNS', 'Integer', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('ITEMINDEX', 'Integer', iptrw);
|
||||||
|
RegisterProperty('ITEMS', 'TStrings', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_ExtCtrls_TypesAndConsts(cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
cl.AddTypeS('TShapeType', '(stRectangle, stSquare, stRoundRect, stRoundSquare, stEllipse, stCircle)');
|
||||||
|
cl.AddTypeS('TBevelStyle', '(bsLowered, bsRaised)');
|
||||||
|
cl.AddTypeS('TBevelShape', '(bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, bsRightLine,bsSpacer)');
|
||||||
|
cl.AddTypeS('TPanelBevel', '(bvNone, bvLowered, bvRaised,bvSpace)');
|
||||||
|
cl.AddTypeS('TBevelWidth', 'Longint');
|
||||||
|
cl.AddTypeS('TBorderWidth', 'Longint');
|
||||||
|
cl.AddTypeS('TSectionEvent', 'procedure(Sender: TObject; ASection, AWidth: Integer)');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_ExtCtrls(cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_ExtCtrls_TypesAndConsts(cl);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTSHAPE(Cl);
|
||||||
|
SIRegisterTIMAGE(Cl);
|
||||||
|
SIRegisterTPAINTBOX(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
SIRegisterTBEVEL(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTTIMER(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
SIRegisterTCUSTOMPANEL(Cl);
|
||||||
|
SIRegisterTPANEL(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
SIRegisterTPAGE(Cl);
|
||||||
|
SIRegisterTNOTEBOOK(Cl);
|
||||||
|
SIRegisterTHEADER(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
SIRegisterTCUSTOMRADIOGROUP(Cl);
|
||||||
|
SIRegisterTRADIOGROUP(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
271
Units/PascalScript/uPSC_forms.pas
Normal file
271
Units/PascalScript/uPSC_forms.pas
Normal file
@ -0,0 +1,271 @@
|
|||||||
|
{ Compiletime Forms support }
|
||||||
|
unit uPSC_forms;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
procedure SIRegister_Forms_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCONTROLSCROLLBAR(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTSCROLLINGWINCONTROL(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTSCROLLBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFORM(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTAPPLICATION(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegister_Forms(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SIRegisterTCONTROLSCROLLBAR(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TPERSISTENT'), 'TCONTROLSCROLLBAR') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('KIND', 'TSCROLLBARKIND', iptr);
|
||||||
|
RegisterProperty('SCROLLPOS', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('MARGIN', 'WORD', iptrw);
|
||||||
|
RegisterProperty('INCREMENT', 'TSCROLLBARINC', iptrw);
|
||||||
|
RegisterProperty('RANGE', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('POSITION', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('TRACKING', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('VISIBLE', 'BOOLEAN', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTSCROLLINGWINCONTROL(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TWINCONTROL'), 'TSCROLLINGWINCONTROL') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('procedure SCROLLINVIEW(ACONTROL:TCONTROL)');
|
||||||
|
RegisterProperty('HORZSCROLLBAR', 'TCONTROLSCROLLBAR', iptrw);
|
||||||
|
RegisterProperty('VERTSCROLLBAR', 'TCONTROLSCROLLBAR', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTSCROLLBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TSCROLLINGWINCONTROL'), 'TSCROLLBOX') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('BORDERSTYLE', 'TBORDERSTYLE', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TCOLOR', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFONT', iptrw);
|
||||||
|
RegisterProperty('AUTOSCROLL', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNOTIFYEVENT', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('ONRESIZE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'TCURSOR', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDRAGMODE', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPOPUPMENU', iptrw);
|
||||||
|
RegisterProperty('CTL3D', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDRAGDROPEVENT', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDRAGOVEREVENT', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TENDDRAGEVENT', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMOUSEEVENT', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMOUSEMOVEEVENT', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMOUSEEVENT', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFORM(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TSCROLLINGWINCONTROL'), 'TFORM') do
|
||||||
|
begin
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
RegisterMethod('constructor CREATENEW(AOWNER:TCOMPONENT; Dummy: Integer)');
|
||||||
|
{$ELSE}
|
||||||
|
RegisterMethod('constructor CREATENEW(AOWNER:TCOMPONENT)');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod('procedure CLOSE');
|
||||||
|
RegisterMethod('procedure HIDE');
|
||||||
|
RegisterMethod('procedure SHOW');
|
||||||
|
RegisterMethod('function SHOWMODAL:INTEGER');
|
||||||
|
RegisterMethod('procedure RELEASE');
|
||||||
|
RegisterProperty('ACTIVE', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('ACTIVECONTROL', 'TWINCONTROL', iptrw);
|
||||||
|
RegisterProperty('BORDERICONS', 'TBorderIcons', iptrw);
|
||||||
|
RegisterProperty('BORDERSTYLE', 'TFORMBORDERSTYLE', iptrw);
|
||||||
|
RegisterProperty('CAPTION', 'NativeString', iptrw);
|
||||||
|
RegisterProperty('AUTOSCROLL', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TCOLOR', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFONT', iptrw);
|
||||||
|
RegisterProperty('FORMSTYLE', 'TFORMSTYLE', iptrw);
|
||||||
|
RegisterProperty('KEYPREVIEW', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('POSITION', 'TPOSITION', iptrw);
|
||||||
|
RegisterProperty('ONACTIVATE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONCLOSE', 'TCLOSEEVENT', iptrw);
|
||||||
|
RegisterProperty('ONCLOSEQUERY', 'TCLOSEQUERYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONCREATE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONDESTROY', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONDEACTIVATE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONHIDE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKEYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKEYPRESSEVENT', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKEYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONRESIZE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONSHOW', 'TNOTIFYEVENT', iptrw);
|
||||||
|
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod('procedure ARRANGEICONS');
|
||||||
|
// RegisterMethod('function GETFORMIMAGE:TBITMAP');
|
||||||
|
RegisterMethod('procedure PRINT');
|
||||||
|
RegisterMethod('procedure SENDCANCELMODE(SENDER:TCONTROL)');
|
||||||
|
RegisterProperty('ACTIVEOLECONTROL', 'TWINCONTROL', iptrw);
|
||||||
|
RegisterProperty('OLEFORMOBJECT', 'TOLEFORMOBJECT', iptrw);
|
||||||
|
RegisterProperty('CLIENTHANDLE', 'LONGINT', iptr);
|
||||||
|
RegisterProperty('TILEMODE', 'TTILEMODE', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod('procedure CASCADE');
|
||||||
|
RegisterMethod('function CLOSEQUERY:BOOLEAN');
|
||||||
|
RegisterMethod('procedure DEFOCUSCONTROL(CONTROL:TWINCONTROL;REMOVING:BOOLEAN)');
|
||||||
|
RegisterMethod('procedure FOCUSCONTROL(CONTROL:TWINCONTROL)');
|
||||||
|
RegisterMethod('procedure NEXT');
|
||||||
|
RegisterMethod('procedure PREVIOUS');
|
||||||
|
RegisterMethod('function SETFOCUSEDCONTROL(CONTROL:TWINCONTROL):BOOLEAN');
|
||||||
|
RegisterMethod('procedure TILE');
|
||||||
|
RegisterProperty('ACTIVEMDICHILD', 'TFORM', iptr);
|
||||||
|
RegisterProperty('CANVAS', 'TCANVAS', iptr);
|
||||||
|
RegisterProperty('DROPTARGET', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('MODALRESULT', 'Longint', iptrw);
|
||||||
|
RegisterProperty('MDICHILDCOUNT', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('MDICHILDREN', 'TFORM INTEGER', iptr);
|
||||||
|
RegisterProperty('ICON', 'TICON', iptrw);
|
||||||
|
RegisterProperty('MENU', 'TMAINMENU', iptrw);
|
||||||
|
RegisterProperty('OBJECTMENUITEM', 'TMENUITEM', iptrw);
|
||||||
|
RegisterProperty('PIXELSPERINCH', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('PRINTSCALE', 'TPRINTSCALE', iptrw);
|
||||||
|
RegisterProperty('SCALED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('WINDOWSTATE', 'TWINDOWSTATE', iptrw);
|
||||||
|
RegisterProperty('WINDOWMENU', 'TMENUITEM', iptrw);
|
||||||
|
RegisterProperty('CTL3D', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPOPUPMENU', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDRAGDROPEVENT', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDRAGOVEREVENT', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMOUSEEVENT', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMOUSEMOVEEVENT', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMOUSEEVENT', iptrw);
|
||||||
|
RegisterProperty('ONPAINT', 'TNOTIFYEVENT', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTAPPLICATION(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCOMPONENT'), 'TAPPLICATION') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('procedure BRINGTOFRONT');
|
||||||
|
{$IFDEF PS_PANSICHAR}
|
||||||
|
RegisterMethod('function MESSAGEBOX(TEXT,CAPTION:PANSICHAR;FLAGS:WORD):INTEGER');
|
||||||
|
{$ELSE}
|
||||||
|
RegisterMethod('function MESSAGEBOX(TEXT,CAPTION:PCHAR;FLAGS:WORD):INTEGER');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod('procedure MINIMIZE');
|
||||||
|
RegisterMethod('procedure PROCESSMESSAGES');
|
||||||
|
RegisterMethod('procedure RESTORE');
|
||||||
|
RegisterMethod('procedure TERMINATE');
|
||||||
|
RegisterProperty('ACTIVE', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('EXENAME', 'NativeString', iptr);
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterProperty('HANDLE', 'LONGINT', iptrw);
|
||||||
|
RegisterProperty('UPDATEFORMATSETTINGS', 'BOOLEAN', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('HINT', 'NativeString', iptrw);
|
||||||
|
RegisterProperty('MAINFORM', 'TFORM', iptr);
|
||||||
|
RegisterProperty('SHOWHINT', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('SHOWMAINFORM', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('TERMINATED', 'BOOLEAN', iptr);
|
||||||
|
RegisterProperty('TITLE', 'NativeString', iptrw);
|
||||||
|
RegisterProperty('ONACTIVATE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONDEACTIVATE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONIDLE', 'TIDLEEVENT', iptrw);
|
||||||
|
RegisterProperty('ONHINT', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONMINIMIZE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONRESTORE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('procedure CONTROLDESTROYED(CONTROL:TCONTROL)');
|
||||||
|
RegisterMethod('procedure CANCELHINT');
|
||||||
|
RegisterMethod('procedure HANDLEEXCEPTION(SENDER:TOBJECT)');
|
||||||
|
RegisterMethod('procedure HANDLEMESSAGE');
|
||||||
|
RegisterMethod('procedure HIDEHINT');
|
||||||
|
// RegisterMethod('procedure HINTMOUSEMESSAGE(CONTROL:TCONTROL;var MESSAGE:TMESSAGE)');
|
||||||
|
RegisterMethod('procedure INITIALIZE');
|
||||||
|
RegisterMethod('procedure NORMALIZETOPMOSTS');
|
||||||
|
RegisterMethod('procedure RESTORETOPMOSTS');
|
||||||
|
RegisterMethod('procedure RUN');
|
||||||
|
// RegisterMethod('procedure SHOWEXCEPTION(E:EXCEPTION)');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod('function HELPCOMMAND(COMMAND:INTEGER;DATA:LONGINT):BOOLEAN');
|
||||||
|
RegisterMethod('function HELPCONTEXT(CONTEXT:THELPCONTEXT):BOOLEAN');
|
||||||
|
RegisterMethod('function HELPJUMP(JUMPID:NativeString):BOOLEAN');
|
||||||
|
RegisterProperty('DIALOGHANDLE', 'LONGINT', iptrw);
|
||||||
|
RegisterMethod('procedure CREATEHANDLE');
|
||||||
|
// RegisterMethod('procedure HOOKMAINWINDOW(HOOK:TWINDOWHOOK)');
|
||||||
|
// RegisterMethod('procedure UNHOOKMAINWINDOW(HOOK:TWINDOWHOOK)');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('HELPFILE', 'NativeString', iptrw);
|
||||||
|
RegisterProperty('HINTCOLOR', 'TCOLOR', iptrw);
|
||||||
|
RegisterProperty('HINTPAUSE', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('HINTSHORTPAUSE', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('HINTHIDEPAUSE', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('ICON', 'TICON', iptrw);
|
||||||
|
RegisterProperty('ONHELP', 'THELPEVENT', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Forms_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
Cl.AddTypeS('TIdleEvent', 'procedure (Sender: TObject; var Done: Boolean)');
|
||||||
|
cl.AddTypeS('TScrollBarKind', '(sbHorizontal, sbVertical)');
|
||||||
|
cl.AddTypeS('TScrollBarInc', 'SmallInt');
|
||||||
|
cl.AddTypeS('TFormBorderStyle', '(bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin)');
|
||||||
|
cl.AddTypeS('TBorderStyle', 'TFormBorderStyle');
|
||||||
|
cl.AddTypeS('TWindowState', '(wsNormal, wsMinimized, wsMaximized)');
|
||||||
|
cl.AddTypeS('TFormStyle', '(fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop)');
|
||||||
|
cl.AddTypeS('TPosition', '(poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poDesktopCenter, poMainFormCenter, poOwnerFormCenter)');
|
||||||
|
cl.AddTypeS('TPrintScale', '(poNone, poProportional, poPrintToFit)');
|
||||||
|
cl.AddTypeS('TCloseAction', '(caNone, caHide, caFree, caMinimize)');
|
||||||
|
cl.AddTypeS('TCloseEvent' ,'procedure(Sender: TObject; var Action: TCloseAction)');
|
||||||
|
cl.AddTypeS('TCloseQueryEvent' ,'procedure(Sender: TObject; var CanClose: Boolean)');
|
||||||
|
cl.AddTypeS('TBorderIcon' ,'(biSystemMenu, biMinimize, biMaximize, biHelp)');
|
||||||
|
cl.AddTypeS('TBorderIcons', 'set of TBorderIcon');
|
||||||
|
cl.AddTypeS('THELPCONTEXT', 'Longint');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Forms(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_Forms_TypesAndConsts(cl);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTCONTROLSCROLLBAR(cl);
|
||||||
|
{$ENDIF}
|
||||||
|
SIRegisterTScrollingWinControl(cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTSCROLLBOX(cl);
|
||||||
|
{$ENDIF}
|
||||||
|
SIRegisterTForm(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTApplication(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
275
Units/PascalScript/uPSC_graphics.pas
Normal file
275
Units/PascalScript/uPSC_graphics.pas
Normal file
@ -0,0 +1,275 @@
|
|||||||
|
{ Compiletime Graphics support }
|
||||||
|
unit uPSC_graphics;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegister_Graphics_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTGRAPHICSOBJECT(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTFont(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPEN(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBRUSH(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCanvas(cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTGraphic(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBitmap(CL: TPSPascalCompiler; Streams: Boolean);
|
||||||
|
|
||||||
|
procedure SIRegister_Graphics(Cl: TPSPascalCompiler; Streams: Boolean);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
{$IFNDEF PS_NOGRAPHCONST}
|
||||||
|
uses
|
||||||
|
{$IFDEF CLX}QGraphics{$ELSE}Graphics{$ENDIF};
|
||||||
|
{$ELSE}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
uses
|
||||||
|
Windows;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure SIRegisterTGRAPHICSOBJECT(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TPERSISTENT'), 'TGRAPHICSOBJECT') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ONCHANGE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTFont(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGraphicsObject'), 'TFONT') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor Create;');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterProperty('Handle', 'Integer', iptRW);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('Color', 'TColor', iptRW);
|
||||||
|
RegisterProperty('Height', 'Integer', iptRW);
|
||||||
|
RegisterProperty('Name', 'String', iptRW);
|
||||||
|
RegisterProperty('Pitch', 'Byte', iptRW);
|
||||||
|
RegisterProperty('Size', 'Integer', iptRW);
|
||||||
|
RegisterProperty('PixelsPerInch', 'Integer', iptRW);
|
||||||
|
RegisterProperty('Style', 'TFontStyles', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTCanvas(cl: TPSPascalCompiler); // requires TPersistent
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TPersistent'), 'TCANVAS') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);');
|
||||||
|
RegisterMethod('procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);');
|
||||||
|
// RegisterMethod('procedure Draw(X, Y: Integer; Graphic: TGraphic);');
|
||||||
|
RegisterMethod('procedure Ellipse(X1, Y1, X2, Y2: Integer);');
|
||||||
|
RegisterMethod('procedure FillRect(const Rect: TRect);');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod('procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: Byte);');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod('procedure LineTo(X, Y: Integer);');
|
||||||
|
RegisterMethod('procedure MoveTo(X, Y: Integer);');
|
||||||
|
RegisterMethod('procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);');
|
||||||
|
RegisterMethod('procedure Rectangle(X1, Y1, X2, Y2: Integer);');
|
||||||
|
RegisterMethod('procedure Refresh;');
|
||||||
|
RegisterMethod('procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);');
|
||||||
|
RegisterMethod('function TextHeight(Text: String): Integer;');
|
||||||
|
RegisterMethod('procedure TextOut(X, Y: Integer; Text: String);');
|
||||||
|
RegisterMethod('function TextWidth(Text: String): Integer;');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterProperty('Handle', 'Integer', iptRw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('Pixels', 'Integer Integer Integer', iptRW);
|
||||||
|
RegisterProperty('Brush', 'TBrush', iptR);
|
||||||
|
RegisterProperty('CopyMode', 'Byte', iptRw);
|
||||||
|
RegisterProperty('Font', 'TFont', iptR);
|
||||||
|
RegisterProperty('Pen', 'TPen', iptR);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPEN(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGRAPHICSOBJECT'), 'TPEN') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor CREATE');
|
||||||
|
RegisterProperty('COLOR', 'TCOLOR', iptrw);
|
||||||
|
RegisterProperty('MODE', 'TPENMODE', iptrw);
|
||||||
|
RegisterProperty('STYLE', 'TPENSTYLE', iptrw);
|
||||||
|
RegisterProperty('WIDTH', 'INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTBRUSH(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGRAPHICSOBJECT'), 'TBRUSH') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor CREATE');
|
||||||
|
RegisterProperty('COLOR', 'TCOLOR', iptrw);
|
||||||
|
RegisterProperty('STYLE', 'TBRUSHSTYLE', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Graphics_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
{$IFDEF PS_NOGRAPHCONST}
|
||||||
|
const
|
||||||
|
clSystemColor = {$IFDEF DELPHI7UP} $FF000000 {$ELSE} $80000000 {$ENDIF};
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_NOGRAPHCONST}
|
||||||
|
cl.AddConstantN('clScrollBar', 'Integer').Value.ts32 := clScrollBar;
|
||||||
|
cl.AddConstantN('clBackground', 'Integer').Value.ts32 := clBackground;
|
||||||
|
cl.AddConstantN('clActiveCaption', 'Integer').Value.ts32 := clActiveCaption;
|
||||||
|
cl.AddConstantN('clInactiveCaption', 'Integer').Value.ts32 := clInactiveCaption;
|
||||||
|
cl.AddConstantN('clMenu', 'Integer').Value.ts32 := clMenu;
|
||||||
|
cl.AddConstantN('clWindow', 'Integer').Value.ts32 := clWindow;
|
||||||
|
cl.AddConstantN('clWindowFrame', 'Integer').Value.ts32 := clWindowFrame;
|
||||||
|
cl.AddConstantN('clMenuText', 'Integer').Value.ts32 := clMenuText;
|
||||||
|
cl.AddConstantN('clWindowText', 'Integer').Value.ts32 := clWindowText;
|
||||||
|
cl.AddConstantN('clCaptionText', 'Integer').Value.ts32 := clCaptionText;
|
||||||
|
cl.AddConstantN('clActiveBorder', 'Integer').Value.ts32 := clActiveBorder;
|
||||||
|
cl.AddConstantN('clInactiveBorder', 'Integer').Value.ts32 := clInactiveCaption;
|
||||||
|
cl.AddConstantN('clAppWorkSpace', 'Integer').Value.ts32 := clAppWorkSpace;
|
||||||
|
cl.AddConstantN('clHighlight', 'Integer').Value.ts32 := clHighlight;
|
||||||
|
cl.AddConstantN('clHighlightText', 'Integer').Value.ts32 := clHighlightText;
|
||||||
|
cl.AddConstantN('clBtnFace', 'Integer').Value.ts32 := clBtnFace;
|
||||||
|
cl.AddConstantN('clBtnShadow', 'Integer').Value.ts32 := clBtnShadow;
|
||||||
|
cl.AddConstantN('clGrayText', 'Integer').Value.ts32 := clGrayText;
|
||||||
|
cl.AddConstantN('clBtnText', 'Integer').Value.ts32 := clBtnText;
|
||||||
|
cl.AddConstantN('clInactiveCaptionText', 'Integer').Value.ts32 := clInactiveCaptionText;
|
||||||
|
cl.AddConstantN('clBtnHighlight', 'Integer').Value.ts32 := clBtnHighlight;
|
||||||
|
cl.AddConstantN('cl3DDkShadow', 'Integer').Value.ts32 := cl3DDkShadow;
|
||||||
|
cl.AddConstantN('cl3DLight', 'Integer').Value.ts32 := cl3DLight;
|
||||||
|
cl.AddConstantN('clInfoText', 'Integer').Value.ts32 := clInfoText;
|
||||||
|
cl.AddConstantN('clInfoBk', 'Integer').Value.ts32 := clInfoBk;
|
||||||
|
{$ELSE}
|
||||||
|
{$IFNDEF CLX} // These are VCL-only; CLX uses different constant values
|
||||||
|
cl.AddConstantN('clScrollBar', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_SCROLLBAR);
|
||||||
|
cl.AddConstantN('clBackground', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_BACKGROUND);
|
||||||
|
cl.AddConstantN('clActiveCaption', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_ACTIVECAPTION);
|
||||||
|
cl.AddConstantN('clInactiveCaption', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_INACTIVECAPTION);
|
||||||
|
cl.AddConstantN('clMenu', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_MENU);
|
||||||
|
cl.AddConstantN('clWindow', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_WINDOW);
|
||||||
|
cl.AddConstantN('clWindowFrame', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_WINDOWFRAME);
|
||||||
|
cl.AddConstantN('clMenuText', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_MENUTEXT);
|
||||||
|
cl.AddConstantN('clWindowText', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_WINDOWTEXT);
|
||||||
|
cl.AddConstantN('clCaptionText', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_CAPTIONTEXT);
|
||||||
|
cl.AddConstantN('clActiveBorder', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_ACTIVEBORDER);
|
||||||
|
cl.AddConstantN('clInactiveBorder', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_INACTIVEBORDER);
|
||||||
|
cl.AddConstantN('clAppWorkSpace', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_APPWORKSPACE);
|
||||||
|
cl.AddConstantN('clHighlight', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_HIGHLIGHT);
|
||||||
|
cl.AddConstantN('clHighlightText', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_HIGHLIGHTTEXT);
|
||||||
|
cl.AddConstantN('clBtnFace', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_BTNFACE);
|
||||||
|
cl.AddConstantN('clBtnShadow', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_BTNSHADOW);
|
||||||
|
cl.AddConstantN('clGrayText', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_GRAYTEXT);
|
||||||
|
cl.AddConstantN('clBtnText', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_BTNTEXT);
|
||||||
|
cl.AddConstantN('clInactiveCaptionText', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_INACTIVECAPTIONTEXT);
|
||||||
|
cl.AddConstantN('clBtnHighlight', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_BTNHIGHLIGHT);
|
||||||
|
cl.AddConstantN('cl3DDkShadow', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_3DDKSHADOW);
|
||||||
|
cl.AddConstantN('cl3DLight', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_3DLIGHT);
|
||||||
|
cl.AddConstantN('clInfoText', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_INFOTEXT);
|
||||||
|
cl.AddConstantN('clInfoBk', 'Integer').Value.ts32 := Integer(clSystemColor or COLOR_INFOBK);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
cl.AddConstantN('clBlack', 'Integer').Value.ts32 := $000000;
|
||||||
|
cl.AddConstantN('clMaroon', 'Integer').Value.ts32 := $000080;
|
||||||
|
cl.AddConstantN('clGreen', 'Integer').Value.ts32 := $008000;
|
||||||
|
cl.AddConstantN('clOlive', 'Integer').Value.ts32 := $008080;
|
||||||
|
cl.AddConstantN('clNavy', 'Integer').Value.ts32 := $800000;
|
||||||
|
cl.AddConstantN('clPurple', 'Integer').Value.ts32 := $800080;
|
||||||
|
cl.AddConstantN('clTeal', 'Integer').Value.ts32 := $808000;
|
||||||
|
cl.AddConstantN('clGray', 'Integer').Value.ts32 := $808080;
|
||||||
|
cl.AddConstantN('clSilver', 'Integer').Value.ts32 := $C0C0C0;
|
||||||
|
cl.AddConstantN('clRed', 'Integer').Value.ts32 := $0000FF;
|
||||||
|
cl.AddConstantN('clLime', 'Integer').Value.ts32 := $00FF00;
|
||||||
|
cl.AddConstantN('clYellow', 'Integer').Value.ts32 := $00FFFF;
|
||||||
|
cl.AddConstantN('clBlue', 'Integer').Value.ts32 := $FF0000;
|
||||||
|
cl.AddConstantN('clFuchsia', 'Integer').Value.ts32 := $FF00FF;
|
||||||
|
cl.AddConstantN('clAqua', 'Integer').Value.ts32 := $FFFF00;
|
||||||
|
cl.AddConstantN('clLtGray', 'Integer').Value.ts32 := $C0C0C0;
|
||||||
|
cl.AddConstantN('clDkGray', 'Integer').Value.ts32 := $808080;
|
||||||
|
cl.AddConstantN('clWhite', 'Integer').Value.ts32 := $FFFFFF;
|
||||||
|
cl.AddConstantN('clNone', 'Integer').Value.ts32 := $1FFFFFFF;
|
||||||
|
cl.AddConstantN('clDefault', 'Integer').Value.ts32 := $20000000;
|
||||||
|
|
||||||
|
Cl.addTypeS('TFONTSTYLE', '(FSBOLD, FSITALIC, FSUNDERLINE, FSSTRIKEOUT)');
|
||||||
|
Cl.addTypeS('TFONTSTYLES', 'set of TFONTSTYLE');
|
||||||
|
|
||||||
|
cl.AddTypeS('TFontPitch', '(fpDefault, fpVariable, fpFixed)');
|
||||||
|
cl.AddTypeS('TPenStyle', '(psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame)');
|
||||||
|
cl.AddTypeS('TPenMode', '(pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor)');
|
||||||
|
cl.AddTypeS('TBrushStyle', '(bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross)');
|
||||||
|
cl.addTypeS('TColor', 'integer');
|
||||||
|
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
cl.addTypeS('HBITMAP', 'Integer');
|
||||||
|
cl.addTypeS('HPALETTE', 'Integer');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTGraphic(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with CL.AddClassN(CL.FindClass('TPersistent'),'TGraphic') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor Create');
|
||||||
|
RegisterMethod('Procedure LoadFromFile( const Filename : String)');
|
||||||
|
RegisterMethod('Procedure SaveToFile( const Filename : String)');
|
||||||
|
RegisterProperty('Empty', 'Boolean', iptr);
|
||||||
|
RegisterProperty('Height', 'Integer', iptrw);
|
||||||
|
RegisterProperty('Modified', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('Width', 'Integer', iptrw);
|
||||||
|
RegisterProperty('OnChange', 'TNotifyEvent', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTBitmap(CL: TPSPascalCompiler; Streams: Boolean);
|
||||||
|
begin
|
||||||
|
with CL.AddClassN(CL.FindClass('TGraphic'),'TBitmap') do
|
||||||
|
begin
|
||||||
|
if Streams then begin
|
||||||
|
RegisterMethod('Procedure LoadFromStream( Stream : TStream)');
|
||||||
|
RegisterMethod('Procedure SaveToStream( Stream : TStream)');
|
||||||
|
end;
|
||||||
|
RegisterProperty('Canvas', 'TCanvas', iptr);
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterProperty('Handle', 'HBITMAP', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFNDEF IFPS_MINIVCL}
|
||||||
|
RegisterMethod('Procedure Dormant');
|
||||||
|
RegisterMethod('Procedure FreeImage');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod('Procedure LoadFromClipboardFormat( AFormat : Word; AData : THandle; APalette : HPALETTE)');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod('Procedure LoadFromResourceName( Instance : THandle; const ResName : String)');
|
||||||
|
RegisterMethod('Procedure LoadFromResourceID( Instance : THandle; ResID : Integer)');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod('Function ReleaseHandle : HBITMAP');
|
||||||
|
RegisterMethod('Function ReleasePalette : HPALETTE');
|
||||||
|
RegisterMethod('Procedure SaveToClipboardFormat( var Format : Word; var Data : THandle; var APalette : HPALETTE)');
|
||||||
|
RegisterProperty('Monochrome', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('Palette', 'HPALETTE', iptrw);
|
||||||
|
RegisterProperty('IgnorePalette', 'Boolean', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('TransparentColor', 'TColor', iptr);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Graphics(Cl: TPSPascalCompiler; Streams: Boolean);
|
||||||
|
begin
|
||||||
|
SIRegister_Graphics_TypesAndConsts(Cl);
|
||||||
|
SIRegisterTGRAPHICSOBJECT(Cl);
|
||||||
|
SIRegisterTFont(Cl);
|
||||||
|
SIRegisterTPEN(cl);
|
||||||
|
SIRegisterTBRUSH(cl);
|
||||||
|
SIRegisterTCanvas(cl);
|
||||||
|
SIRegisterTGraphic(Cl);
|
||||||
|
SIRegisterTBitmap(Cl, Streams);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
End.
|
||||||
214
Units/PascalScript/uPSC_menus.pas
Normal file
214
Units/PascalScript/uPSC_menus.pas
Normal file
@ -0,0 +1,214 @@
|
|||||||
|
{ Menus Import Unit }
|
||||||
|
Unit uPSC_menus;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
Interface
|
||||||
|
Uses uPSCompiler;
|
||||||
|
|
||||||
|
procedure SIRegisterTMENUITEMSTACK(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPOPUPLIST(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPOPUPMENU(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTMAINMENU(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTMENU(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTMENUITEM(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegister_Menus(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SIRegisterTMENUITEMSTACK(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
With cl.AddClassN(Cl.FindClass('TSTACK'),'TMENUITEMSTACK') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Procedure CLEARITEM( AITEM : TMENUITEM)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPOPUPLIST(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
With cl.AddClassN(Cl.FindClass('TLIST'),'TPOPUPLIST') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('WINDOW', 'HWND', iptr);
|
||||||
|
RegisterMethod('Procedure ADD( POPUP : TPOPUPMENU)');
|
||||||
|
RegisterMethod('Procedure REMOVE( POPUP : TPOPUPMENU)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPOPUPMENU(CL: TPSPascalCompiler);
|
||||||
|
var
|
||||||
|
cc: TPSCompileTimeClass;
|
||||||
|
begin
|
||||||
|
With cl.AddClassN(Cl.FindClass('TMENU'),'TPOPUPMENU') do
|
||||||
|
begin
|
||||||
|
cc := Cl.FindClass('TLabel');
|
||||||
|
if cc <> nil then
|
||||||
|
RegisterProperty('POPUPMENU', 'TPOPUPMENU', iptRW);
|
||||||
|
with Cl.FindClass('TForm') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('POPUPMENU', 'TPOPUPMENU', iptRW);
|
||||||
|
end;
|
||||||
|
RegisterMethod('Constructor CREATE( AOWNER : TCOMPONENT)');
|
||||||
|
RegisterMethod('Procedure POPUP( X, Y : INTEGER)');
|
||||||
|
RegisterProperty('POPUPCOMPONENT', 'TCOMPONENT', iptrw);
|
||||||
|
RegisterProperty('ALIGNMENT', 'TPOPUPALIGNMENT', iptrw);
|
||||||
|
RegisterProperty('AUTOPOPUP', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('HELPCONTEXT', 'THELPCONTEXT', iptrw);
|
||||||
|
RegisterProperty('MENUANIMATION', 'TMENUANIMATION', iptrw);
|
||||||
|
RegisterProperty('TRACKBUTTON', 'TTRACKBUTTON', iptrw);
|
||||||
|
RegisterProperty('ONPOPUP', 'TNOTIFYEVENT', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTMAINMENU(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
With cl.AddClassN(Cl.FindClass('TMENU'),'TMAINMENU') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Procedure MERGE( MENU : TMAINMENU)');
|
||||||
|
RegisterMethod('Procedure UNMERGE( MENU : TMAINMENU)');
|
||||||
|
RegisterMethod('Procedure POPULATEOLE2MENU( SHAREDMENU : HMENU; GROUPS : array of INTEGER; var WIDTHS : array of LONGINT)');
|
||||||
|
RegisterMethod('Procedure GETOLE2ACCELERATORTABLE( var ACCELTABLE : HACCEL; var ACCELCOUNT : INTEGER; GROUPS : array of INTEGER)');
|
||||||
|
RegisterMethod('Procedure SETOLE2MENUHANDLE( HANDLE : HMENU)');
|
||||||
|
RegisterProperty('AUTOMERGE', 'BOOLEAN', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTMENU(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
With cl.AddClassN(Cl.FindClass('TCOMPONENT'),'TMENU') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor CREATE( AOWNER : TCOMPONENT)');
|
||||||
|
RegisterMethod('Function DISPATCHCOMMAND( ACOMMAND : WORD) : BOOLEAN');
|
||||||
|
RegisterMethod('Function DISPATCHPOPUP( AHANDLE : HMENU) : BOOLEAN');
|
||||||
|
RegisterMethod('Function FINDITEM( VALUE : INTEGER; KIND : TFINDITEMKIND) : TMENUITEM');
|
||||||
|
RegisterMethod('Function GETHELPCONTEXT( VALUE : INTEGER; BYCOMMAND : BOOLEAN) : THELPCONTEXT');
|
||||||
|
RegisterProperty('IMAGES', 'TCUSTOMIMAGELIST', iptrw);
|
||||||
|
RegisterMethod('Function ISRIGHTTOLEFT : BOOLEAN');
|
||||||
|
RegisterMethod('Procedure PARENTBIDIMODECHANGED( ACONTROL : TOBJECT)');
|
||||||
|
RegisterMethod('Procedure PROCESSMENUCHAR( var MESSAGE : TWMMENUCHAR)');
|
||||||
|
RegisterProperty('AUTOHOTKEYS', 'TMENUAUTOFLAG', iptrw);
|
||||||
|
RegisterProperty('AUTOLINEREDUCTION', 'TMENUAUTOFLAG', iptrw);
|
||||||
|
RegisterProperty('BIDIMODE', 'TBIDIMODE', iptrw);
|
||||||
|
RegisterProperty('HANDLE', 'HMENU', iptr);
|
||||||
|
RegisterProperty('OWNERDRAW', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('PARENTBIDIMODE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('WINDOWHANDLE', 'HWND', iptrw);
|
||||||
|
RegisterProperty('ITEMS', 'TMENUITEM', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTMENUITEM(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
With cl.AddClassN(Cl.FindClass('TCOMPONENT'),'TMENUITEM') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor CREATE( AOWNER : TCOMPONENT)');
|
||||||
|
RegisterMethod('Procedure INITIATEACTION');
|
||||||
|
RegisterMethod('Procedure INSERT( INDEX : INTEGER; ITEM : TMENUITEM)');
|
||||||
|
RegisterMethod('Procedure DELETE( INDEX : INTEGER)');
|
||||||
|
RegisterMethod('Procedure CLEAR');
|
||||||
|
RegisterMethod('Procedure CLICK');
|
||||||
|
RegisterMethod('Function FIND( ACAPTION : String) : TMENUITEM');
|
||||||
|
RegisterMethod('Function INDEXOF( ITEM : TMENUITEM) : INTEGER');
|
||||||
|
RegisterMethod('Function ISLINE : BOOLEAN');
|
||||||
|
RegisterMethod('Function GETIMAGELIST : TCUSTOMIMAGELIST');
|
||||||
|
RegisterMethod('Function GETPARENTCOMPONENT : TCOMPONENT');
|
||||||
|
RegisterMethod('Function GETPARENTMENU : TMENU');
|
||||||
|
RegisterMethod('Function HASPARENT : BOOLEAN');
|
||||||
|
RegisterMethod('Function NEWTOPLINE : INTEGER');
|
||||||
|
RegisterMethod('Function NEWBOTTOMLINE : INTEGER');
|
||||||
|
RegisterMethod('Function INSERTNEWLINEBEFORE( AITEM : TMENUITEM) : INTEGER');
|
||||||
|
RegisterMethod('Function INSERTNEWLINEAFTER( AITEM : TMENUITEM) : INTEGER');
|
||||||
|
RegisterMethod('Procedure ADD( ITEM : TMENUITEM)');
|
||||||
|
RegisterMethod('Procedure REMOVE( ITEM : TMENUITEM)');
|
||||||
|
RegisterMethod('Function RETHINKHOTKEYS : BOOLEAN');
|
||||||
|
RegisterMethod('Function RETHINKLINES : BOOLEAN');
|
||||||
|
RegisterProperty('COMMAND', 'WORD', iptr);
|
||||||
|
RegisterProperty('HANDLE', 'HMENU', iptr);
|
||||||
|
RegisterProperty('COUNT', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('ITEMS', 'TMENUITEM INTEGER', iptr);
|
||||||
|
RegisterProperty('MENUINDEX', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('PARENT', 'TMENUITEM', iptr);
|
||||||
|
{$IFDEF DELPHI5UP}
|
||||||
|
RegisterProperty('ACTION', 'TBASICACTION', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('AUTOHOTKEYS', 'TMENUITEMAUTOFLAG', iptrw);
|
||||||
|
RegisterProperty('AUTOLINEREDUCTION', 'TMENUITEMAUTOFLAG', iptrw);
|
||||||
|
RegisterProperty('BITMAP', 'TBITMAP', iptrw);
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('CHECKED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('SUBMENUIMAGES', 'TCUSTOMIMAGELIST', iptrw);
|
||||||
|
RegisterProperty('DEFAULT', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ENABLED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('GROUPINDEX', 'BYTE', iptrw);
|
||||||
|
RegisterProperty('HELPCONTEXT', 'THELPCONTEXT', iptrw);
|
||||||
|
RegisterProperty('HINT', 'String', iptrw);
|
||||||
|
RegisterProperty('IMAGEINDEX', 'TIMAGEINDEX', iptrw);
|
||||||
|
RegisterProperty('RADIOITEM', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('SHORTCUT', 'TSHORTCUT', iptrw);
|
||||||
|
RegisterProperty('VISIBLE', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNOTIFYEVENT', iptrw);
|
||||||
|
{$IFNDEF FPC} RegisterProperty('ONDRAWITEM', 'TMENUDRAWITEMEVENT', iptrw);
|
||||||
|
RegisterProperty('ONADVANCEDDRAWITEM', 'TADVANCEDMENUDRAWITEMEVENT', iptrw);
|
||||||
|
RegisterProperty('ONMEASUREITEM', 'TMENUMEASUREITEMEVENT', iptrw);{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Menus(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
Cl.AddTypeS('HMenu', 'Cardinal');
|
||||||
|
Cl.AddTypeS('HACCEL', 'Cardinal');
|
||||||
|
|
||||||
|
cl.addClassN(cl.FindClass('EXCEPTION'),'EMENUERROR');
|
||||||
|
Cl.addTypeS('TMENUBREAK', '( MBNONE, MBBREAK, MBBARBREAK )');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
Cl.addTypeS('TMENUDRAWITEMEVENT', 'Procedure ( SENDER : TOBJECT; ACANVAS : TC'
|
||||||
|
+'ANVAS; ARECT : TRECT; SELECTED : BOOLEAN)');
|
||||||
|
Cl.addTypeS('TADVANCEDMENUDRAWITEMEVENT', 'Procedure ( SENDER : TOBJECT; ACAN'
|
||||||
|
+'VAS : TCANVAS; ARECT : TRECT; STATE : TOWNERDRAWSTATE)');
|
||||||
|
Cl.addTypeS('TMENUMEASUREITEMEVENT', 'Procedure ( SENDER : TOBJECT; ACANVAS :'
|
||||||
|
+' TCANVAS; var WIDTH, HEIGHT : INTEGER)');
|
||||||
|
{$ENDIF}
|
||||||
|
Cl.addTypeS('TMENUITEMAUTOFLAG', '( MAAUTOMATIC, MAMANUAL, MAPARENT )');
|
||||||
|
Cl.AddTypeS('TMenuAutoFlag', 'TMENUITEMAUTOFLAG');
|
||||||
|
Cl.addTypeS('TSHORTCUT', 'WORD');
|
||||||
|
cl.addClassN(cl.FindClass('TACTIONLINK'),'TMENUACTIONLINK');
|
||||||
|
SIRegisterTMENUITEM(Cl);
|
||||||
|
Cl.addTypeS('TMENUCHANGEEVENT', 'Procedure ( SENDER : TOBJECT; SOURCE : TMENU'
|
||||||
|
+'ITEM; REBUILD : BOOLEAN)');
|
||||||
|
Cl.addTypeS('TFINDITEMKIND', '( FKCOMMAND, FKHANDLE, FKSHORTCUT )');
|
||||||
|
SIRegisterTMENU(Cl);
|
||||||
|
SIRegisterTMAINMENU(Cl);
|
||||||
|
Cl.addTypeS('TPOPUPALIGNMENT', '( PALEFT, PARIGHT, PACENTER )');
|
||||||
|
Cl.addTypeS('TTRACKBUTTON', '( TBRIGHTBUTTON, TBLEFTBUTTON )');
|
||||||
|
Cl.addTypeS('TMENUANIMATIONS', '( MALEFTTORIGHT, MARIGHTTOLEFT, MATOPTOBOTTOM'
|
||||||
|
+', MABOTTOMTOTOP, MANONE )');
|
||||||
|
Cl.addTypeS('TMENUANIMATION', 'set of TMENUANIMATIONS');
|
||||||
|
SIRegisterTPOPUPMENU(Cl);
|
||||||
|
SIRegisterTPOPUPLIST(Cl);
|
||||||
|
SIRegisterTMENUITEMSTACK(Cl);
|
||||||
|
Cl.addTypeS('TCMENUITEM', 'TMENUITEM');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
//TODO: it should work,but somehow TShiftState is not defined
|
||||||
|
Cl.AddDelphiFunction('Function SHORTCUT( KEY : WORD; SHIFT : TSHIFTSTATE) : T'
|
||||||
|
+'SHORTCUT');
|
||||||
|
Cl.AddDelphiFunction('Procedure SHORTCUTTOKEY( SHORTCUT : TSHORTCUT; var KEY '
|
||||||
|
+': WORD; var SHIFT : TSHIFTSTATE)');
|
||||||
|
{$ENDIF}
|
||||||
|
Cl.AddDelphiFunction('Function SHORTCUTTOTEXT( SHORTCUT : TSHORTCUT) : String'
|
||||||
|
+'');
|
||||||
|
Cl.AddDelphiFunction('Function TEXTTOSHORTCUT( TEXT : String) : TSHORTCUT');
|
||||||
|
Cl.AddDelphiFunction('Function NEWMENU( OWNER : TCOMPONENT; const ANAME : STR'
|
||||||
|
+'ING; ITEMS : array of TMenuItem) : TMAINMENU');
|
||||||
|
Cl.AddDelphiFunction('Function NEWPOPUPMENU( OWNER : TCOMPONENT; const ANAME '
|
||||||
|
+': String; ALIGNMENT : TPOPUPALIGNMENT; AUTOPOPUP : BOOLEAN; const ITEMS : array of '
|
||||||
|
+'TCMENUITEM) : TPOPUPMENU');
|
||||||
|
Cl.AddDelphiFunction('Function NEWSUBMENU( const ACAPTION : String; HCTX : WO'
|
||||||
|
+'RD; const ANAME : String; ITEMS : array of TMenuItem; AENABLED : BOOLEAN) : TMENUITEM');
|
||||||
|
Cl.AddDelphiFunction('Function NEWITEM( const ACAPTION : String; ASHORTCUT : '
|
||||||
|
+'TSHORTCUT; ACHECKED, AENABLED : BOOLEAN; AONCLICK : TNOTIFYEVENT; HCTX : W'
|
||||||
|
+'ORD; const ANAME : String) : TMENUITEM');
|
||||||
|
Cl.AddDelphiFunction('Function NEWLINE : TMENUITEM');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
Cl.AddDelphiFunction('Procedure DRAWMENUITEM( MENUITEM : TMENUITEM; ACANVAS :'
|
||||||
|
+' TCANVAS; ARECT : TRECT; STATE : TOWNERDRAWSTATE)');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
87
Units/PascalScript/uPSC_std.pas
Normal file
87
Units/PascalScript/uPSC_std.pas
Normal file
@ -0,0 +1,87 @@
|
|||||||
|
{ Compiletime TObject, TPersistent and TComponent definitions }
|
||||||
|
unit uPSC_std;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
{
|
||||||
|
Will register files from:
|
||||||
|
System
|
||||||
|
Classes (Only TComponent and TPersistent)
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
procedure SIRegister_Std_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTObject(CL: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTPersistent(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTComponent(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegister_Std(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SIRegisterTObject(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(nil, 'TObject') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('constructor Create');
|
||||||
|
RegisterMethod('procedure Free');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTPersistent(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TObject'), 'TPersistent') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('procedure Assign(Source: TPersistent)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTComponent(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TPersistent'), 'TComponent') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('function FindComponent(AName: String): TComponent;');
|
||||||
|
RegisterMethod('constructor Create(AOwner: TComponent); virtual;');
|
||||||
|
|
||||||
|
RegisterProperty('Owner', 'TComponent', iptRW);
|
||||||
|
RegisterMethod('procedure DestroyComponents');
|
||||||
|
RegisterMethod('procedure Destroying');
|
||||||
|
RegisterMethod('procedure FreeNotification(AComponent:TComponent)');
|
||||||
|
RegisterMethod('procedure InsertComponent(AComponent:TComponent)');
|
||||||
|
RegisterMethod('procedure RemoveComponent(AComponent:TComponent)');
|
||||||
|
RegisterProperty('Components', 'TComponent Integer', iptr);
|
||||||
|
RegisterProperty('ComponentCount', 'Integer', iptr);
|
||||||
|
RegisterProperty('ComponentIndex', 'Integer', iptrw);
|
||||||
|
RegisterProperty('ComponentState', 'Byte', iptr);
|
||||||
|
RegisterProperty('Designinfo', 'LongInt', iptrw);
|
||||||
|
RegisterProperty('Name', 'String', iptrw);
|
||||||
|
RegisterProperty('Tag', 'LongInt', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegister_Std_TypesAndConsts(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
Cl.AddTypeS('TComponentStateE', '(csLoading, csReading, csWriting, csDestroying, csDesigning, csAncestor, csUpdating, csFixups, csFreeNotification, csInline, csDesignInstance)');
|
||||||
|
cl.AddTypeS('TComponentState', 'set of TComponentStateE');
|
||||||
|
Cl.AddTypeS('TRect', 'record Left, Top, Right, Bottom: Integer; end;');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_Std(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_Std_TypesAndConsts(Cl);
|
||||||
|
SIRegisterTObject(CL);
|
||||||
|
SIRegisterTPersistent(Cl);
|
||||||
|
SIRegisterTComponent(Cl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
|
||||||
|
End.
|
||||||
|
|
||||||
|
|
||||||
633
Units/PascalScript/uPSC_stdctrls.pas
Normal file
633
Units/PascalScript/uPSC_stdctrls.pas
Normal file
@ -0,0 +1,633 @@
|
|||||||
|
{ Compiletime STDCtrls support }
|
||||||
|
unit uPSC_stdctrls;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
{
|
||||||
|
Will register files from:
|
||||||
|
stdctrls
|
||||||
|
|
||||||
|
Requires:
|
||||||
|
STD, classes, controls and graphics
|
||||||
|
}
|
||||||
|
|
||||||
|
procedure SIRegister_StdCtrls_TypesAndConsts(cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMGROUPBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTGROUPBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCUSTOMLABEL(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTLABEL(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCUSTOMEDIT(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTEDIT(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCUSTOMMEMO(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTMEMO(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCUSTOMCOMBOBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCOMBOBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBUTTONCONTROL(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTBUTTON(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCUSTOMCHECKBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCHECKBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTRADIOBUTTON(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTCUSTOMLISTBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTLISTBOX(Cl: TPSPascalCompiler);
|
||||||
|
procedure SIRegisterTSCROLLBAR(Cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
procedure SIRegister_StdCtrls(cl: TPSPascalCompiler);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMGROUPBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TCUSTOMGROUPBOX');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTGROUPBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMGROUPBOX'), 'TGROUPBOX') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMLABEL(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TGRAPHICCONTROL'), 'TCUSTOMLABEL') do
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterProperty('CANVAS', 'TCANVAS', iptr);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTLABEL(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMLABEL'), 'TLABEL') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ALIGNMENT', 'TAlignment', iptrw);
|
||||||
|
RegisterProperty('AUTOSIZE', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('FOCUSCONTROL', 'TWinControl', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('LAYOUT', 'TTextLayout', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('SHOWACCELCHAR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('TRANSPARENT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('WORDWRAP', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMEDIT(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TWINCONTROL'), 'TCUSTOMEDIT') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('procedure CLEAR');
|
||||||
|
RegisterMethod('procedure CLEARSELECTION');
|
||||||
|
RegisterMethod('procedure SELECTALL');
|
||||||
|
RegisterProperty('MODIFIED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('SELLENGTH', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('SELSTART', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('SELTEXT', 'String', iptrw);
|
||||||
|
RegisterProperty('TEXT', 'String', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('procedure COPYTOCLIPBOARD');
|
||||||
|
RegisterMethod('procedure CUTTOCLIPBOARD');
|
||||||
|
RegisterMethod('procedure PASTEFROMCLIPBOARD');
|
||||||
|
RegisterMethod('function GETSELTEXTBUF(BUFFER:PCHAR;BUFSIZE:INTEGER):INTEGER');
|
||||||
|
RegisterMethod('procedure SETSELTEXTBUF(BUFFER:PCHAR)');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTEDIT(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMEDIT'), 'TEDIT') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('AUTOSELECT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('AUTOSIZE', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('BORDERSTYLE', 'TBorderStyle', iptrw);
|
||||||
|
RegisterProperty('CHARCASE', 'TEditCharCase', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('HIDESELECTION', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('MAXLENGTH', 'Integer', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PASSWORDCHAR', 'Char', iptrw);
|
||||||
|
RegisterProperty('READONLY', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('TEXT', 'String', iptrw);
|
||||||
|
RegisterProperty('ONCHANGE', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKeyPressEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKeyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('OEMCONVERT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMMEMO(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMEDIT'), 'TCUSTOMMEMO') do
|
||||||
|
begin
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterProperty('LINES', 'TSTRINGS', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTMEMO(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMMEMO'), 'TMEMO') do
|
||||||
|
begin
|
||||||
|
{$IFDEF CLX}
|
||||||
|
RegisterProperty('LINES', 'TSTRINGS', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterProperty('ALIGNMENT', 'TAlignment', iptrw);
|
||||||
|
RegisterProperty('BORDERSTYLE', 'TBorderStyle', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('HIDESELECTION', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('MAXLENGTH', 'Integer', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('READONLY', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('SCROLLBARS', 'TScrollStyle', iptrw);
|
||||||
|
RegisterProperty('WANTRETURNS', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('WANTTABS', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('WORDWRAP', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCHANGE', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKeyPressEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKeyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('OEMCONVERT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMCOMBOBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TWINCONTROL'), 'TCUSTOMCOMBOBOX') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('DROPPEDDOWN', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('ITEMS', 'TSTRINGS', iptrw);
|
||||||
|
RegisterProperty('ITEMINDEX', 'INTEGER', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('procedure CLEAR');
|
||||||
|
RegisterMethod('procedure SELECTALL');
|
||||||
|
RegisterProperty('CANVAS', 'TCANVAS', iptr);
|
||||||
|
RegisterProperty('SELLENGTH', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('SELSTART', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('SELTEXT', 'String', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCOMBOBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMCOMBOBOX'), 'TCOMBOBOX') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('STYLE', 'TComboBoxStyle', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('DROPDOWNCOUNT', 'Integer', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('MAXLENGTH', 'Integer', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('SORTED', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('TEXT', 'String', iptrw);
|
||||||
|
RegisterProperty('ONCHANGE', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDROPDOWN', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKeyPressEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKeyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('ITEMHEIGHT', 'Integer', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAWITEM', 'TDrawItemEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMEASUREITEM', 'TMeasureItemEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTBUTTONCONTROL(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TWINCONTROL'), 'TBUTTONCONTROL') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTBUTTON(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TBUTTONCONTROL'), 'TBUTTON') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('CANCEL', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('DEFAULT', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('MODALRESULT', 'LONGINT', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKeyPressEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMCHECKBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TBUTTONCONTROL'), 'TCUSTOMCHECKBOX') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCHECKBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMCHECKBOX'), 'TCHECKBOX') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ALIGNMENT', 'TAlignment', iptrw);
|
||||||
|
RegisterProperty('ALLOWGRAYED', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('CHECKED', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('STATE', 'TCheckBoxState', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKeyPressEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTRADIOBUTTON(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TBUTTONCONTROL'), 'TRADIOBUTTON') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ALIGNMENT', 'TALIGNMENT', iptrw);
|
||||||
|
RegisterProperty('CAPTION', 'String', iptrw);
|
||||||
|
RegisterProperty('CHECKED', 'BOOLEAN', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKeyPressEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTCUSTOMLISTBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TWINCONTROL'), 'TCUSTOMLISTBOX') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('ITEMS', 'TSTRINGS', iptrw);
|
||||||
|
RegisterProperty('ITEMINDEX', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('SELCOUNT', 'INTEGER', iptr);
|
||||||
|
RegisterProperty('SELECTED', 'BOOLEAN INTEGER', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('procedure CLEAR');
|
||||||
|
RegisterMethod('function ITEMATPOS(POS:TPOINT;EXISTING:BOOLEAN):INTEGER');
|
||||||
|
RegisterMethod('function ITEMRECT(INDEX:INTEGER):TRECT');
|
||||||
|
RegisterProperty('CANVAS', 'TCANVAS', iptr);
|
||||||
|
RegisterProperty('TOPINDEX', 'INTEGER', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTLISTBOX(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TCUSTOMLISTBOX'), 'TLISTBOX') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('BORDERSTYLE', 'TBorderStyle', iptrw);
|
||||||
|
RegisterProperty('COLOR', 'TColor', iptrw);
|
||||||
|
RegisterProperty('FONT', 'TFont', iptrw);
|
||||||
|
RegisterProperty('MULTISELECT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTFONT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('SORTED', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('STYLE', 'TListBoxStyle', iptrw);
|
||||||
|
RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONDBLCLICK', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKeyPressEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKeyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterProperty('COLUMNS', 'Integer', iptrw);
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('EXTENDEDSELECT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('INTEGRALHEIGHT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('ITEMHEIGHT', 'Integer', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('TABWIDTH', 'Integer', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAWITEM', 'TDrawItemEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONMEASUREITEM', 'TMeasureItemEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEDOWN', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEMOVE', 'TMouseMoveEvent', iptrw);
|
||||||
|
RegisterProperty('ONMOUSEUP', 'TMouseEvent', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTSCROLLBAR(Cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with Cl.AddClassN(cl.FindClass('TWINCONTROL'), 'TSCROLLBAR') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('KIND', 'TSCROLLBARKIND', iptrw);
|
||||||
|
RegisterProperty('MAX', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('MIN', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('POSITION', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('ONCHANGE', 'TNOTIFYEVENT', iptrw);
|
||||||
|
RegisterProperty('ONENTER', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('ONEXIT', 'TNotifyEvent', iptrw);
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod('procedure SETPARAMS(APOSITION,AMIN,AMAX:INTEGER)');
|
||||||
|
RegisterProperty('CTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('DRAGCURSOR', 'Longint', iptrw);
|
||||||
|
RegisterProperty('DRAGMODE', 'TDragMode', iptrw);
|
||||||
|
RegisterProperty('LARGECHANGE', 'TSCROLLBARINC', iptrw);
|
||||||
|
RegisterProperty('PARENTCTL3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PARENTSHOWHINT', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('POPUPMENU', 'TPopupMenu', iptrw);
|
||||||
|
RegisterProperty('SMALLCHANGE', 'TSCROLLBARINC', iptrw);
|
||||||
|
RegisterProperty('ONDRAGDROP', 'TDragDropEvent', iptrw);
|
||||||
|
RegisterProperty('ONDRAGOVER', 'TDragOverEvent', iptrw);
|
||||||
|
RegisterProperty('ONENDDRAG', 'TEndDragEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYDOWN', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYPRESS', 'TKeyPressEvent', iptrw);
|
||||||
|
RegisterProperty('ONKEYUP', 'TKeyEvent', iptrw);
|
||||||
|
RegisterProperty('ONSCROLL', 'TSCROLLEVENT', iptrw);
|
||||||
|
RegisterProperty('ONSTARTDRAG', 'TStartDragEvent', iptrw);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegister_StdCtrls_TypesAndConsts(cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
cl.AddTypeS('TEditCharCase', '(ecNormal, ecUpperCase, ecLowerCase)');
|
||||||
|
cl.AddTypeS('TScrollStyle', '(ssNone, ssHorizontal, ssVertical, ssBoth)');
|
||||||
|
cl.AddTypeS('TComboBoxStyle', '(csDropDown, csSimple, csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable)');
|
||||||
|
cl.AddTypeS('TDrawItemEvent', 'procedure(Control: TWinControl; Index: Integer; Rect: TRect; State: Byte)');
|
||||||
|
cl.AddTypeS('TMeasureItemEvent', 'procedure(Control: TWinControl; Index: Integer; var Height: Integer)');
|
||||||
|
cl.AddTypeS('TCheckBoxState', '(cbUnchecked, cbChecked, cbGrayed)');
|
||||||
|
cl.AddTypeS('TListBoxStyle', '(lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable)');
|
||||||
|
cl.AddTypeS('TScrollCode', '(scLineUp, scLineDown, scPageUp, scPageDown, scPosition, scTrack, scTop, scBottom, scEndScroll)');
|
||||||
|
cl.AddTypeS('TScrollEvent', 'procedure(Sender: TObject; ScrollCode: TScrollCode;var ScrollPos: Integer)');
|
||||||
|
|
||||||
|
Cl.addTypeS('TEOwnerDrawState', '(odSelected, odGrayed, odDisabled, odChecked,'
|
||||||
|
+' odFocused, odDefault, odHotLight, odInactive, odNoAccel, odNoFocusRect,'
|
||||||
|
+' odReserved1, odReserved2, odComboBoxEdit)');
|
||||||
|
cl.AddTypeS('TTextLayout', '( tlTop, tlCenter, tlBottom )');
|
||||||
|
cl.AddTypeS('TOwnerDrawState', 'set of TEOwnerDrawState');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegister_stdctrls(cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_StdCtrls_TypesAndConsts(cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTCUSTOMGROUPBOX(Cl);
|
||||||
|
SIRegisterTGROUPBOX(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
SIRegisterTCUSTOMLABEL(Cl);
|
||||||
|
SIRegisterTLABEL(Cl);
|
||||||
|
SIRegisterTCUSTOMEDIT(Cl);
|
||||||
|
SIRegisterTEDIT(Cl);
|
||||||
|
SIRegisterTCUSTOMMEMO(Cl);
|
||||||
|
SIRegisterTMEMO(Cl);
|
||||||
|
SIRegisterTCUSTOMCOMBOBOX(Cl);
|
||||||
|
SIRegisterTCOMBOBOX(Cl);
|
||||||
|
SIRegisterTBUTTONCONTROL(Cl);
|
||||||
|
SIRegisterTBUTTON(Cl);
|
||||||
|
SIRegisterTCUSTOMCHECKBOX(Cl);
|
||||||
|
SIRegisterTCHECKBOX(Cl);
|
||||||
|
SIRegisterTRADIOBUTTON(Cl);
|
||||||
|
SIRegisterTCUSTOMLISTBOX(Cl);
|
||||||
|
SIRegisterTLISTBOX(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
SIRegisterTSCROLLBAR(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
15397
Units/PascalScript/uPSCompiler.pas
Normal file
15397
Units/PascalScript/uPSCompiler.pas
Normal file
File diff suppressed because it is too large
Load Diff
1511
Units/PascalScript/uPSComponent.pas
Normal file
1511
Units/PascalScript/uPSComponent.pas
Normal file
File diff suppressed because it is too large
Load Diff
1010
Units/PascalScript/uPSComponentExt.pas
Normal file
1010
Units/PascalScript/uPSComponentExt.pas
Normal file
File diff suppressed because it is too large
Load Diff
38
Units/PascalScript/uPSComponent_COM.pas
Normal file
38
Units/PascalScript/uPSComponent_COM.pas
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
|
||||||
|
unit uPSComponent_COM;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime;
|
||||||
|
type
|
||||||
|
|
||||||
|
TPSImport_ComObj = class(TPSPlugin)
|
||||||
|
private
|
||||||
|
public
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TIFPS3CE_ComObj = class(TPSImport_ComObj);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
uPSC_comobj,
|
||||||
|
uPSR_comobj;
|
||||||
|
|
||||||
|
|
||||||
|
{ TPSImport_ComObj }
|
||||||
|
|
||||||
|
procedure TPSImport_ComObj.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
SIRegister_ComObj(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TPSImport_ComObj.ExecImport1(CompExec: TPSScript;
|
||||||
|
const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_ComObj(CompExec.Exec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
65
Units/PascalScript/uPSComponent_Controls.pas
Normal file
65
Units/PascalScript/uPSComponent_Controls.pas
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
unit uPSComponent_Controls;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime;
|
||||||
|
type
|
||||||
|
|
||||||
|
TPSImport_Controls = class(TPSPlugin)
|
||||||
|
private
|
||||||
|
FEnableStreams: Boolean;
|
||||||
|
FEnableGraphics: Boolean;
|
||||||
|
FEnableControls: Boolean;
|
||||||
|
public
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
published
|
||||||
|
|
||||||
|
property EnableStreams: Boolean read FEnableStreams write FEnableStreams;
|
||||||
|
|
||||||
|
property EnableGraphics: Boolean read FEnableGraphics write FEnableGraphics;
|
||||||
|
|
||||||
|
property EnableControls: Boolean read FEnableControls write FEnableControls;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TIFPS3CE_Controls = class(TPSImport_Controls);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
uPSC_graphics,
|
||||||
|
uPSC_controls,
|
||||||
|
uPSR_graphics,
|
||||||
|
uPSR_controls;
|
||||||
|
|
||||||
|
|
||||||
|
{ TPSImport_Controls }
|
||||||
|
|
||||||
|
procedure TPSImport_Controls.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
if FEnableGraphics then
|
||||||
|
SIRegister_Graphics(CompExec.Comp, FEnableStreams);
|
||||||
|
if FEnableControls then
|
||||||
|
SIRegister_Controls(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPSImport_Controls.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FEnableStreams := True;
|
||||||
|
FEnableGraphics := True;
|
||||||
|
FEnableControls := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSImport_Controls.ExecImport1(CompExec: TPSScript;
|
||||||
|
const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
if FEnableGraphics then
|
||||||
|
RIRegister_Graphics(ri, FEnableStreams);
|
||||||
|
if FEnableControls then
|
||||||
|
RIRegister_Controls(ri);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
36
Units/PascalScript/uPSComponent_DB.pas
Normal file
36
Units/PascalScript/uPSComponent_DB.pas
Normal file
@ -0,0 +1,36 @@
|
|||||||
|
unit uPSComponent_DB;
|
||||||
|
|
||||||
|
interface
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSRuntime, uPSCompiler;
|
||||||
|
type
|
||||||
|
|
||||||
|
TPSImport_DB = class(TPSPlugin)
|
||||||
|
public
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
public
|
||||||
|
end;
|
||||||
|
|
||||||
|
TIFPS3CE_DB = class(TPSImport_DB);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
uPSC_DB,
|
||||||
|
uPSR_DB;
|
||||||
|
|
||||||
|
{ TPSImport_DB }
|
||||||
|
|
||||||
|
procedure TPSImport_DB.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
SIRegister_DB(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSImport_DB.ExecImport1(CompExec: TPSScript;
|
||||||
|
const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_DB(RI);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
81
Units/PascalScript/uPSComponent_Default.pas
Normal file
81
Units/PascalScript/uPSComponent_Default.pas
Normal file
@ -0,0 +1,81 @@
|
|||||||
|
unit uPSComponent_Default;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
TPSImport_DateUtils = class(TPSPlugin)
|
||||||
|
public
|
||||||
|
procedure CompOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure ExecOnUses(CompExec: TPSScript); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPSImport_Classes = class(TPSPlugin)
|
||||||
|
private
|
||||||
|
FEnableStreams: Boolean;
|
||||||
|
FEnableClasses: Boolean;
|
||||||
|
public
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
public
|
||||||
|
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
published
|
||||||
|
|
||||||
|
property EnableStreams: Boolean read FEnableStreams write FEnableStreams;
|
||||||
|
|
||||||
|
property EnableClasses: Boolean read FEnableClasses write FEnableClasses;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TIFPS3CE_Std = class(TPSImport_Classes);
|
||||||
|
|
||||||
|
TIFPS3CE_DateUtils = class(TPSImport_DateUtils);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
uPSC_std,
|
||||||
|
uPSR_std,
|
||||||
|
uPSC_classes,
|
||||||
|
uPSR_classes,
|
||||||
|
uPSC_dateutils,
|
||||||
|
uPSR_dateutils;
|
||||||
|
|
||||||
|
{ TPSImport_Classes }
|
||||||
|
|
||||||
|
procedure TPSImport_Classes.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
SIRegister_Std(CompExec.Comp);
|
||||||
|
if FEnableClasses then
|
||||||
|
SIRegister_Classes(CompExec.Comp, FEnableStreams);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSImport_Classes.ExecImport1(CompExec: TPSScript;
|
||||||
|
const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_Std(Ri);
|
||||||
|
if FEnableClasses then
|
||||||
|
RIRegister_Classes(ri, FEnableStreams);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPSImport_Classes.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FEnableStreams := True;
|
||||||
|
FEnableClasses := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSImport_DateUtils }
|
||||||
|
|
||||||
|
procedure TPSImport_DateUtils.CompOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
RegisterDateTimeLibrary_C(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSImport_DateUtils.ExecOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
RegisterDateTimeLibrary_R(CompExec.Exec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
65
Units/PascalScript/uPSComponent_Forms.pas
Normal file
65
Units/PascalScript/uPSComponent_Forms.pas
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
|
||||||
|
unit uPSComponent_Forms;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSRuntime, uPSCompiler, uPSComponent;
|
||||||
|
type
|
||||||
|
|
||||||
|
TPSImport_Forms = class(TPSPlugin)
|
||||||
|
private
|
||||||
|
FEnableForms: Boolean;
|
||||||
|
FEnableMenus: Boolean;
|
||||||
|
public
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
published
|
||||||
|
|
||||||
|
property EnableForms: Boolean read FEnableForms write FEnableForms;
|
||||||
|
|
||||||
|
property EnableMenus: Boolean read FEnableMenus write FEnableMenus;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TIFPS3CE_Forms = class(TPSImport_Forms);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
uPSC_forms,
|
||||||
|
uPSC_menus,
|
||||||
|
uPSR_forms,
|
||||||
|
uPSR_menus;
|
||||||
|
|
||||||
|
{ TPSImport_Forms }
|
||||||
|
|
||||||
|
procedure TPSImport_Forms.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
if FEnableForms then
|
||||||
|
SIRegister_Forms(CompExec.comp);
|
||||||
|
if FEnableMenus then
|
||||||
|
SIRegister_Menus(CompExec.comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPSImport_Forms.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(Aowner);
|
||||||
|
FEnableForms := True;
|
||||||
|
FEnableMenus := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSImport_Forms.ExecImport1(CompExec: TPSScript;
|
||||||
|
const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
if FEnableForms then
|
||||||
|
RIRegister_Forms(ri);
|
||||||
|
|
||||||
|
if FEnableMenus then
|
||||||
|
begin
|
||||||
|
RIRegister_Menus(ri);
|
||||||
|
RIRegister_Menus_Routines(compexec.Exec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
65
Units/PascalScript/uPSComponent_StdCtrls.pas
Normal file
65
Units/PascalScript/uPSComponent_StdCtrls.pas
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
|
||||||
|
unit uPSComponent_StdCtrls;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime;
|
||||||
|
type
|
||||||
|
|
||||||
|
TPSImport_StdCtrls = class(TPSPlugin)
|
||||||
|
private
|
||||||
|
FEnableButtons: Boolean;
|
||||||
|
FEnableExtCtrls: Boolean;
|
||||||
|
public
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
published
|
||||||
|
|
||||||
|
property EnableExtCtrls: Boolean read FEnableExtCtrls write FEnableExtCtrls;
|
||||||
|
|
||||||
|
property EnableButtons: Boolean read FEnableButtons write FEnableButtons;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TIFPS3CE_StdCtrls = class(TPSImport_StdCtrls);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
uPSC_buttons,
|
||||||
|
uPSC_stdctrls,
|
||||||
|
uPSC_extctrls,
|
||||||
|
uPSR_buttons,
|
||||||
|
uPSR_stdctrls,
|
||||||
|
uPSR_extctrls;
|
||||||
|
|
||||||
|
{ TPSImport_StdCtrls }
|
||||||
|
|
||||||
|
procedure TPSImport_StdCtrls.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
SIRegister_stdctrls(CompExec.Comp);
|
||||||
|
if FEnableExtCtrls then
|
||||||
|
SIRegister_ExtCtrls(CompExec.Comp);
|
||||||
|
if FEnableButtons then
|
||||||
|
SIRegister_Buttons(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPSImport_StdCtrls.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(Aowner);
|
||||||
|
FEnableButtons := True;
|
||||||
|
FEnableExtCtrls := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSImport_StdCtrls.ExecImport1(CompExec: TPSScript;
|
||||||
|
const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_stdctrls(RI);
|
||||||
|
if FEnableExtCtrls then
|
||||||
|
RIRegister_ExtCtrls(RI);
|
||||||
|
if FEnableButtons then
|
||||||
|
RIRegister_Buttons(RI);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
654
Units/PascalScript/uPSDebugger.pas
Normal file
654
Units/PascalScript/uPSDebugger.pas
Normal file
@ -0,0 +1,654 @@
|
|||||||
|
|
||||||
|
unit uPSDebugger;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils, uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
TDebugMode = (dmRun
|
||||||
|
, dmStepOver
|
||||||
|
, dmStepInto
|
||||||
|
, dmPaused
|
||||||
|
);
|
||||||
|
|
||||||
|
TPSCustomDebugExec = class(TPSExec)
|
||||||
|
protected
|
||||||
|
FDebugDataForProcs: TIfList;
|
||||||
|
FLastProc: TPSProcRec;
|
||||||
|
FCurrentDebugProc: Pointer;
|
||||||
|
FProcNames: TIFStringList;
|
||||||
|
FGlobalVarNames: TIfStringList;
|
||||||
|
FCurrentSourcePos, FCurrentRow, FCurrentCol: Cardinal;
|
||||||
|
FCurrentFile: tbtstring;
|
||||||
|
|
||||||
|
function GetCurrentProcParams: TIfStringList;
|
||||||
|
|
||||||
|
function GetCurrentProcVars: TIfStringList;
|
||||||
|
protected
|
||||||
|
|
||||||
|
procedure ClearDebug; virtual;
|
||||||
|
public
|
||||||
|
|
||||||
|
function GetCurrentProcNo: Cardinal;
|
||||||
|
|
||||||
|
function GetCurrentPosition: Cardinal;
|
||||||
|
|
||||||
|
function TranslatePosition(Proc, Position: Cardinal): Cardinal;
|
||||||
|
|
||||||
|
function TranslatePositionEx(Proc, Position: Cardinal; var Pos, Row, Col: Cardinal; var Fn: tbtstring): Boolean;
|
||||||
|
|
||||||
|
procedure LoadDebugData(const Data: tbtstring);
|
||||||
|
|
||||||
|
procedure Clear; override;
|
||||||
|
|
||||||
|
property GlobalVarNames: TIfStringList read FGlobalVarNames;
|
||||||
|
|
||||||
|
property ProcNames: TIfStringList read FProcNames;
|
||||||
|
|
||||||
|
property CurrentProcVars: TIfStringList read GetCurrentProcVars;
|
||||||
|
|
||||||
|
property CurrentProcParams: TIfStringList read GetCurrentProcParams;
|
||||||
|
|
||||||
|
function GetGlobalVar(I: Cardinal): PIfVariant;
|
||||||
|
|
||||||
|
function GetProcVar(I: Cardinal): PIfVariant;
|
||||||
|
|
||||||
|
function GetProcParam(I: Cardinal): PIfVariant;
|
||||||
|
|
||||||
|
constructor Create;
|
||||||
|
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
TPSDebugExec = class;
|
||||||
|
|
||||||
|
TOnSourceLine = procedure (Sender: TPSDebugExec; const Name: tbtstring; Position, Row, Col: Cardinal);
|
||||||
|
|
||||||
|
TOnIdleCall = procedure (Sender: TPSDebugExec);
|
||||||
|
|
||||||
|
TPSDebugExec = class(TPSCustomDebugExec)
|
||||||
|
private
|
||||||
|
FDebugMode: TDebugMode;
|
||||||
|
FStepOverProc: TPSInternalProcRec;
|
||||||
|
FStepOverStackBase: Cardinal;
|
||||||
|
FOnIdleCall: TOnIdleCall;
|
||||||
|
FOnSourceLine: TOnSourceLine;
|
||||||
|
FDebugEnabled: Boolean;
|
||||||
|
protected
|
||||||
|
|
||||||
|
procedure SourceChanged;
|
||||||
|
procedure ClearDebug; override;
|
||||||
|
procedure RunLine; override;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
|
||||||
|
function LoadData(const s: tbtstring): Boolean; override;
|
||||||
|
|
||||||
|
procedure Pause; override;
|
||||||
|
|
||||||
|
procedure Run;
|
||||||
|
|
||||||
|
procedure StepInto;
|
||||||
|
|
||||||
|
procedure StepOver;
|
||||||
|
|
||||||
|
procedure Stop; override;
|
||||||
|
|
||||||
|
property DebugMode: TDebugMode read FDebugMode;
|
||||||
|
|
||||||
|
property OnSourceLine: TOnSourceLine read FOnSourceLine write FOnSourceLine;
|
||||||
|
|
||||||
|
property OnIdleCall: TOnIdleCall read FOnIdleCall write FOnIdleCall;
|
||||||
|
|
||||||
|
property DebugEnabled: Boolean read FDebugEnabled write FDebugEnabled;
|
||||||
|
end;
|
||||||
|
TIFPSDebugExec = TPSDebugExec;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP }
|
||||||
|
resourceString
|
||||||
|
{$ELSE }
|
||||||
|
const
|
||||||
|
{$ENDIF }
|
||||||
|
|
||||||
|
RPS_ExpectedReturnAddressStackBase = 'Expected return address at stack base';
|
||||||
|
|
||||||
|
type
|
||||||
|
PPositionData = ^TPositionData;
|
||||||
|
TPositionData = packed record
|
||||||
|
FileName: tbtstring;
|
||||||
|
Position,
|
||||||
|
Row,
|
||||||
|
Col,
|
||||||
|
SourcePosition: Cardinal;
|
||||||
|
end;
|
||||||
|
PFunctionInfo = ^TFunctionInfo;
|
||||||
|
TFunctionInfo = packed record
|
||||||
|
Func: TPSProcRec;
|
||||||
|
FParamNames: TIfStringList;
|
||||||
|
FVariableNames: TIfStringList;
|
||||||
|
FPositionTable: TIfList;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSCustomDebugExec }
|
||||||
|
|
||||||
|
procedure TPSCustomDebugExec.Clear;
|
||||||
|
begin
|
||||||
|
inherited Clear;
|
||||||
|
if FGlobalVarNames <> nil then ClearDebug;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSCustomDebugExec.ClearDebug;
|
||||||
|
var
|
||||||
|
i, j: Longint;
|
||||||
|
p: PFunctionInfo;
|
||||||
|
begin
|
||||||
|
FCurrentDebugProc := nil;
|
||||||
|
FLastProc := nil;
|
||||||
|
FProcNames.Clear;
|
||||||
|
FGlobalVarNames.Clear;
|
||||||
|
FCurrentSourcePos := 0;
|
||||||
|
FCurrentRow := 0;
|
||||||
|
FCurrentCol := 0;
|
||||||
|
FCurrentFile := '';
|
||||||
|
for i := 0 to FDebugDataForProcs.Count -1 do
|
||||||
|
begin
|
||||||
|
p := FDebugDataForProcs[I];
|
||||||
|
for j := 0 to p^.FPositionTable.Count -1 do
|
||||||
|
begin
|
||||||
|
Dispose(PPositionData(P^.FPositionTable[J]));
|
||||||
|
end;
|
||||||
|
p^.FPositionTable.Free;
|
||||||
|
p^.FParamNames.Free;
|
||||||
|
p^.FVariableNames.Free;
|
||||||
|
Dispose(p);
|
||||||
|
end;
|
||||||
|
FDebugDataForProcs.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPSCustomDebugExec.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FCurrentSourcePos := 0;
|
||||||
|
FCurrentRow := 0;
|
||||||
|
FCurrentCol := 0;
|
||||||
|
FCurrentFile := '';
|
||||||
|
FDebugDataForProcs := TIfList.Create;
|
||||||
|
FLastProc := nil;
|
||||||
|
FCurrentDebugProc := nil;
|
||||||
|
FProcNames := TIFStringList.Create;
|
||||||
|
FGlobalVarNames := TIfStringList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TPSCustomDebugExec.Destroy;
|
||||||
|
begin
|
||||||
|
Clear;
|
||||||
|
FDebugDataForProcs.Free;
|
||||||
|
FProcNames.Free;
|
||||||
|
FGlobalVarNames.Free;
|
||||||
|
FGlobalVarNames := nil;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.GetCurrentPosition: Cardinal;
|
||||||
|
begin
|
||||||
|
Result := TranslatePosition(GetCurrentProcNo, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.GetCurrentProcNo: Cardinal;
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
begin
|
||||||
|
for i := 0 to FProcs.Count -1 do
|
||||||
|
begin
|
||||||
|
if FProcs[i]= FCurrProc then
|
||||||
|
begin
|
||||||
|
Result := I;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := Cardinal(-1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.GetCurrentProcParams: TIfStringList;
|
||||||
|
begin
|
||||||
|
if FCurrentDebugProc <> nil then
|
||||||
|
begin
|
||||||
|
Result := PFunctionInfo(FCurrentDebugProc)^.FParamNames;
|
||||||
|
end else Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.GetCurrentProcVars: TIfStringList;
|
||||||
|
begin
|
||||||
|
if FCurrentDebugProc <> nil then
|
||||||
|
begin
|
||||||
|
Result := PFunctionInfo(FCurrentDebugProc)^.FVariableNames;
|
||||||
|
end else Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.GetGlobalVar(I: Cardinal): PIfVariant;
|
||||||
|
begin
|
||||||
|
Result := FGlobalVars[I];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.GetProcParam(I: Cardinal): PIfVariant;
|
||||||
|
begin
|
||||||
|
Result := FStack[Cardinal(Longint(FCurrStackBase) - Longint(I) - 1)];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.GetProcVar(I: Cardinal): PIfVariant;
|
||||||
|
begin
|
||||||
|
Result := FStack[Cardinal(Longint(FCurrStackBase) + Longint(I) + 1)];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetProcDebugInfo(FProcs: TIFList; Proc: TPSProcRec): PFunctionInfo;
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
c: PFunctionInfo;
|
||||||
|
begin
|
||||||
|
if Proc = nil then
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
for i := FProcs.Count -1 downto 0 do
|
||||||
|
begin
|
||||||
|
c := FProcs.Data^[I];
|
||||||
|
if c^.Func = Proc then
|
||||||
|
begin
|
||||||
|
Result := c;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
new(c);
|
||||||
|
c^.Func := Proc;
|
||||||
|
c^.FPositionTable := TIfList.Create;
|
||||||
|
c^.FVariableNames := TIfStringList.Create;
|
||||||
|
c^.FParamNames := TIfStringList.Create;
|
||||||
|
FProcs.Add(c);
|
||||||
|
REsult := c;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSCustomDebugExec.LoadDebugData(const Data: tbtstring);
|
||||||
|
var
|
||||||
|
CP, I: Longint;
|
||||||
|
c: tbtchar;
|
||||||
|
CurrProcNo, LastProcNo: Cardinal;
|
||||||
|
LastProc: PFunctionInfo;
|
||||||
|
NewLoc: PPositionData;
|
||||||
|
s: tbtstring;
|
||||||
|
begin
|
||||||
|
ClearDebug;
|
||||||
|
if FStatus = isNotLoaded then exit;
|
||||||
|
CP := 1;
|
||||||
|
LastProcNo := Cardinal(-1);
|
||||||
|
LastProc := nil;
|
||||||
|
while CP <= length(Data) do
|
||||||
|
begin
|
||||||
|
c := Data[CP];
|
||||||
|
inc(cp);
|
||||||
|
case c of
|
||||||
|
#0:
|
||||||
|
begin
|
||||||
|
i := cp;
|
||||||
|
if i > length(data) then exit;
|
||||||
|
while Data[i] <> #0 do
|
||||||
|
begin
|
||||||
|
if Data[i] = #1 then
|
||||||
|
begin
|
||||||
|
FProcNames.Add(Copy(Data, cp, i-cp));
|
||||||
|
cp := I + 1;
|
||||||
|
end;
|
||||||
|
inc(I);
|
||||||
|
if I > length(data) then exit;
|
||||||
|
end;
|
||||||
|
cp := i + 1;
|
||||||
|
end;
|
||||||
|
#1:
|
||||||
|
begin
|
||||||
|
i := cp;
|
||||||
|
if i > length(data) then exit;
|
||||||
|
while Data[i] <> #0 do
|
||||||
|
begin
|
||||||
|
if Data[i] = #1 then
|
||||||
|
begin
|
||||||
|
FGlobalVarNames.Add(Copy(Data, cp, i-cp));
|
||||||
|
cp := I + 1;
|
||||||
|
end;
|
||||||
|
inc(I);
|
||||||
|
if I > length(data) then exit;
|
||||||
|
end;
|
||||||
|
cp := i + 1;
|
||||||
|
end;
|
||||||
|
#2:
|
||||||
|
begin
|
||||||
|
if cp + 4 > Length(data) then exit;
|
||||||
|
CurrProcNo := Cardinal((@Data[cp])^);
|
||||||
|
if CurrProcNo = Cardinal(-1) then Exit;
|
||||||
|
if CurrProcNo <> LastProcNo then
|
||||||
|
begin
|
||||||
|
LastProcNo := CurrProcNo;
|
||||||
|
LastProc := GetProcDebugInfo(FDebugDataForProcs, FProcs[CurrProcNo]);
|
||||||
|
if LastProc = nil then exit;
|
||||||
|
end;
|
||||||
|
inc(cp, 4);
|
||||||
|
|
||||||
|
i := cp;
|
||||||
|
if i > length(data) then exit;
|
||||||
|
while Data[i] <> #0 do
|
||||||
|
begin
|
||||||
|
if Data[i] = #1 then
|
||||||
|
begin
|
||||||
|
LastProc^.FParamNames.Add(Copy(Data, cp, i-cp));
|
||||||
|
cp := I + 1;
|
||||||
|
end;
|
||||||
|
inc(I);
|
||||||
|
if I > length(data) then exit;
|
||||||
|
end;
|
||||||
|
cp := i + 1;
|
||||||
|
end;
|
||||||
|
#3:
|
||||||
|
begin
|
||||||
|
if cp + 4 > Length(data) then exit;
|
||||||
|
CurrProcNo := Cardinal((@Data[cp])^);
|
||||||
|
if CurrProcNo = Cardinal(-1) then Exit;
|
||||||
|
if CurrProcNo <> LastProcNo then
|
||||||
|
begin
|
||||||
|
LastProcNo := CurrProcNo;
|
||||||
|
LastProc := GetProcDebugInfo(FDebugDataForProcs, FProcs[CurrProcNo]);
|
||||||
|
if LastProc = nil then exit;
|
||||||
|
end;
|
||||||
|
inc(cp, 4);
|
||||||
|
|
||||||
|
i := cp;
|
||||||
|
if i > length(data) then exit;
|
||||||
|
while Data[i] <> #0 do
|
||||||
|
begin
|
||||||
|
if Data[i] = #1 then
|
||||||
|
begin
|
||||||
|
LastProc^.FVariableNames.Add(Copy(Data, cp, i-cp));
|
||||||
|
cp := I + 1;
|
||||||
|
end;
|
||||||
|
inc(I);
|
||||||
|
if I > length(data) then exit;
|
||||||
|
end;
|
||||||
|
cp := i + 1;
|
||||||
|
end;
|
||||||
|
#4:
|
||||||
|
begin
|
||||||
|
i := cp;
|
||||||
|
if i > length(data) then exit;
|
||||||
|
while Data[i] <> #0 do
|
||||||
|
begin
|
||||||
|
if Data[i] = #1 then
|
||||||
|
begin
|
||||||
|
s := Copy(Data, cp, i-cp);
|
||||||
|
cp := I + 1;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
inc(I);
|
||||||
|
if I > length(data) then exit;
|
||||||
|
end;
|
||||||
|
if cp + 4 > Length(data) then exit;
|
||||||
|
CurrProcNo := Cardinal((@Data[cp])^);
|
||||||
|
if CurrProcNo = Cardinal(-1) then Exit;
|
||||||
|
if CurrProcNo <> LastProcNo then
|
||||||
|
begin
|
||||||
|
LastProcNo := CurrProcNo;
|
||||||
|
LastProc := GetProcDebugInfo(FDebugDataForProcs, FProcs[CurrProcNo]);
|
||||||
|
if LastProc = nil then exit;
|
||||||
|
end;
|
||||||
|
inc(cp, 4);
|
||||||
|
if cp + 16 > Length(data) then exit;
|
||||||
|
new(NewLoc);
|
||||||
|
NewLoc^.Position := Cardinal((@Data[Cp])^);
|
||||||
|
NewLoc^.FileName := s;
|
||||||
|
NewLoc^.SourcePosition := Cardinal((@Data[Cp+4])^);
|
||||||
|
NewLoc^.Row := Cardinal((@Data[Cp+8])^);
|
||||||
|
NewLoc^.Col := Cardinal((@Data[Cp+12])^);
|
||||||
|
inc(cp, 16);
|
||||||
|
LastProc^.FPositionTable.Add(NewLoc);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ClearDebug;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.TranslatePosition(Proc, Position: Cardinal): Cardinal;
|
||||||
|
var
|
||||||
|
D1, D2: Cardinal;
|
||||||
|
s: tbtstring;
|
||||||
|
begin
|
||||||
|
if not TranslatePositionEx(Proc, Position, Result, D1, D2, s) then
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSCustomDebugExec.TranslatePositionEx(Proc, Position: Cardinal;
|
||||||
|
var Pos, Row, Col: Cardinal; var Fn: tbtstring): Boolean;
|
||||||
|
// Made by Martijn Laan (mlaan@wintax.nl)
|
||||||
|
var
|
||||||
|
i: LongInt;
|
||||||
|
fi: PFunctionInfo;
|
||||||
|
pt: TIfList;
|
||||||
|
r: PPositionData;
|
||||||
|
lastfn: tbtstring;
|
||||||
|
LastPos, LastRow, LastCol: Cardinal;
|
||||||
|
pp: TPSProcRec;
|
||||||
|
begin
|
||||||
|
fi := nil;
|
||||||
|
pp := FProcs[Proc];
|
||||||
|
for i := 0 to FDebugDataForProcs.Count -1 do
|
||||||
|
begin
|
||||||
|
fi := FDebugDataForProcs[i];
|
||||||
|
if fi^.Func = pp then
|
||||||
|
Break;
|
||||||
|
fi := nil;
|
||||||
|
end;
|
||||||
|
LastPos := 0;
|
||||||
|
LastRow := 0;
|
||||||
|
LastCol := 0;
|
||||||
|
if fi <> nil then begin
|
||||||
|
pt := fi^.FPositionTable;
|
||||||
|
for i := 0 to pt.Count -1 do
|
||||||
|
begin
|
||||||
|
r := pt[I];
|
||||||
|
if r^.Position >= Position then
|
||||||
|
begin
|
||||||
|
if r^.Position = Position then
|
||||||
|
begin
|
||||||
|
Pos := r^.SourcePosition;
|
||||||
|
Row := r^.Row;
|
||||||
|
Col := r^.Col;
|
||||||
|
Fn := r^.Filename;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Pos := LastPos;
|
||||||
|
Row := LastRow;
|
||||||
|
Col := LastCol;
|
||||||
|
Fn := LastFn;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
exit;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
LastPos := r^.SourcePosition;
|
||||||
|
LastRow := r^.Row;
|
||||||
|
LastCol := r^.Col;
|
||||||
|
LastFn := r^.FileName;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Pos := LastPos;
|
||||||
|
Row := LastRow;
|
||||||
|
Col := LastCol;
|
||||||
|
Result := True;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSDebugExec }
|
||||||
|
procedure TPSDebugExec.ClearDebug;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FDebugMode := dmRun;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSDebugExec.LoadData(const s: tbtstring): Boolean;
|
||||||
|
begin
|
||||||
|
Result := inherited LoadData(s);
|
||||||
|
FDebugMode := dmRun;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSDebugExec.RunLine;
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
pt: TIfList;
|
||||||
|
r: PPositionData;
|
||||||
|
begin
|
||||||
|
inherited RunLine;
|
||||||
|
if not DebugEnabled then exit;
|
||||||
|
if FCurrProc <> FLastProc then
|
||||||
|
begin
|
||||||
|
FLastProc := FCurrProc;
|
||||||
|
FCurrentDebugProc := nil;
|
||||||
|
for i := 0 to FDebugDataForProcs.Count -1 do
|
||||||
|
begin
|
||||||
|
if PFunctionInfo(FDebugDataForProcs[I])^.Func = FLastProc then
|
||||||
|
begin
|
||||||
|
FCurrentDebugProc := FDebugDataForProcs[I];
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if FCurrentDebugProc <> nil then
|
||||||
|
begin
|
||||||
|
pt := PFunctionInfo(FCurrentDebugProc)^.FPositionTable;
|
||||||
|
for i := 0 to pt.Count -1 do
|
||||||
|
begin
|
||||||
|
r := pt[I];
|
||||||
|
if r^.Position = FCurrentPosition then
|
||||||
|
begin
|
||||||
|
FCurrentSourcePos := r^.SourcePosition;
|
||||||
|
FCurrentRow := r^.Row;
|
||||||
|
FCurrentCol := r^.Col;
|
||||||
|
FCurrentFile := r^.FileName;
|
||||||
|
SourceChanged;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
FCurrentSourcePos := 0;
|
||||||
|
FCurrentRow := 0;
|
||||||
|
FCurrentCol := 0;
|
||||||
|
FCurrentFile := '';
|
||||||
|
end;
|
||||||
|
while FDebugMode = dmPaused do
|
||||||
|
begin
|
||||||
|
if @FOnIdleCall <> nil then
|
||||||
|
begin
|
||||||
|
FOnIdleCall(Self);
|
||||||
|
end else break; // endless loop
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TPSDebugExec.SourceChanged;
|
||||||
|
|
||||||
|
function StepOverShouldPause: Boolean;
|
||||||
|
var
|
||||||
|
I: Cardinal;
|
||||||
|
V: PPSVariant;
|
||||||
|
begin
|
||||||
|
if (FCurrProc <> FStepOverProc) or (FCurrStackBase <> FStepOverStackBase) then
|
||||||
|
begin
|
||||||
|
{ We're not inside the function being stepped, so scan the call stack to
|
||||||
|
see if we're inside a function called by the function being stepped }
|
||||||
|
I := FCurrStackBase;
|
||||||
|
while Longint(I) > Longint(FStepOverStackBase) do
|
||||||
|
begin
|
||||||
|
V := FStack.Items[I];
|
||||||
|
if (V = nil) or (V.FType <> FReturnAddressType) then
|
||||||
|
raise Exception.Create(RPS_ExpectedReturnAddressStackBase);
|
||||||
|
if (PPSVariantReturnAddress(V).Addr.ProcNo = FStepOverProc) and
|
||||||
|
(PPSVariantReturnAddress(V).Addr.StackBase = FStepOverStackBase) then
|
||||||
|
begin
|
||||||
|
{ We are, so don't pause }
|
||||||
|
Result := False;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
I := PPSVariantReturnAddress(V).Addr.StackBase;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
case FDebugMode of
|
||||||
|
dmStepInto:
|
||||||
|
begin
|
||||||
|
FDebugMode := dmPaused;
|
||||||
|
end;
|
||||||
|
dmStepOver:
|
||||||
|
begin
|
||||||
|
if StepOverShouldPause then
|
||||||
|
begin
|
||||||
|
FDebugMode := dmPaused;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if @FOnSourceLine <> nil then
|
||||||
|
FOnSourceLine(Self, FCurrentFile, FCurrentSourcePos, FCurrentRow, FCurrentCol);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TPSDebugExec.Pause;
|
||||||
|
begin
|
||||||
|
FDebugMode := dmPaused;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSDebugExec.Stop;
|
||||||
|
begin
|
||||||
|
FDebugMode := dmRun;
|
||||||
|
inherited Stop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSDebugExec.Run;
|
||||||
|
begin
|
||||||
|
FDebugMode := dmRun;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSDebugExec.StepInto;
|
||||||
|
begin
|
||||||
|
FDebugMode := dmStepInto;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSDebugExec.StepOver;
|
||||||
|
begin
|
||||||
|
FStepOverProc := FCurrProc;
|
||||||
|
FStepOverStackBase := FCurrStackBase;
|
||||||
|
FDebugMode := dmStepOver;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor TPSDebugExec.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FDebugEnabled := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
499
Units/PascalScript/uPSDisassembly.pas
Normal file
499
Units/PascalScript/uPSDisassembly.pas
Normal file
@ -0,0 +1,499 @@
|
|||||||
|
|
||||||
|
|
||||||
|
unit uPSDisassembly;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils, sysutils;
|
||||||
|
|
||||||
|
function IFPS3DataToText(const Input: tbtstring; var Output: string): Boolean;
|
||||||
|
implementation
|
||||||
|
|
||||||
|
type
|
||||||
|
TMyPSExec = class(TPSExec)
|
||||||
|
function ImportProc(const Name: ShortString; proc: TIFExternalProcRec): Boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function Debug2Str(const s: string): string;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
result := '';
|
||||||
|
for i := 1 to length(s) do
|
||||||
|
begin
|
||||||
|
if (s[i] < #32) or (s[i] > #128) then
|
||||||
|
result := result + '\'+inttohex(ord(s[i]), 2)
|
||||||
|
else if s[i] = '\' then
|
||||||
|
result := result + '\\'
|
||||||
|
else
|
||||||
|
result := result + s[i];
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SpecImportProc(Sender: TObject; p: TIFExternalProcRec): Boolean; forward;
|
||||||
|
|
||||||
|
function FloatToStr(Value: Extended): string;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := SysUtils.FloatToStr(Value);
|
||||||
|
except
|
||||||
|
Result := 'NaNa';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function IFPS3DataToText(const Input: tbtstring; var Output: string): Boolean;
|
||||||
|
var
|
||||||
|
I: TMyPSExec;
|
||||||
|
|
||||||
|
procedure Writeln(const s: string);
|
||||||
|
begin
|
||||||
|
Output := Output + s + #13#10;
|
||||||
|
end;
|
||||||
|
function BT2S(P: PIFTypeRec): string;
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
begin
|
||||||
|
case p.BaseType of
|
||||||
|
btU8: Result := 'U8';
|
||||||
|
btS8: Result := 'S8';
|
||||||
|
btU16: Result := 'U16';
|
||||||
|
btS16: Result := 'S16';
|
||||||
|
btU32: Result := 'U32';
|
||||||
|
btS32: Result := 'S32';
|
||||||
|
{$IFNDEF PS_NOINT64}bts64: Result := 'S64'; {$ENDIF}
|
||||||
|
btChar: Result := {$IFDEF UNICODE}'AnsiChar'{$ELSE}'Char'{$ENDIF};
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}
|
||||||
|
btWideChar: Result := 'WideChar';
|
||||||
|
btWideString: Result := 'WideString';
|
||||||
|
{$ENDIF}
|
||||||
|
btSet: Result := 'Set';
|
||||||
|
btSingle: Result := 'Single';
|
||||||
|
btDouble: Result := 'Double';
|
||||||
|
btExtended: Result := 'Extended';
|
||||||
|
btString: Result := 'String';
|
||||||
|
btRecord:
|
||||||
|
begin
|
||||||
|
Result := 'Record(';
|
||||||
|
for i := 0 to TPSTypeRec_Record(p).FieldTypes.Count-1 do
|
||||||
|
begin
|
||||||
|
if i <> 0 then Result := Result+',';
|
||||||
|
Result := Result + BT2S(PIFTypeRec(TPSTypeRec_Record(p).FieldTypes[i]));
|
||||||
|
end;
|
||||||
|
Result := Result + ')';
|
||||||
|
end;
|
||||||
|
btArray: Result := 'Array of '+BT2S(TPSTypeRec_Array(p).ArrayType);
|
||||||
|
btResourcePointer: Result := 'ResourcePointer';
|
||||||
|
btPointer: Result := 'Pointer';
|
||||||
|
btVariant: Result := 'Variant';
|
||||||
|
btClass: Result := 'Class';
|
||||||
|
btProcPtr: Result := 'ProcPtr';
|
||||||
|
btStaticArray: Result := 'StaticArray['+inttostR(TPSTypeRec_StaticArray(p).Size)+'] of '+BT2S(TPSTypeRec_Array(p).ArrayType);
|
||||||
|
else
|
||||||
|
Result := 'Unknown '+inttostr(p.BaseType);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
procedure WriteTypes;
|
||||||
|
var
|
||||||
|
T: Longint;
|
||||||
|
begin
|
||||||
|
Writeln('[TYPES]');
|
||||||
|
for T := 0 to i.FTypes.Count -1 do
|
||||||
|
begin
|
||||||
|
if PIFTypeRec(i.FTypes[t]).ExportName <> '' then
|
||||||
|
Writeln('Type ['+inttostr(t)+']: '+bt2s(PIFTypeRec(i.FTypes[t]))+' Export: '+PIFTypeRec(i.FTypes[t]).ExportName)
|
||||||
|
else
|
||||||
|
Writeln('Type ['+inttostr(t)+']: '+bt2s(PIFTypeRec(i.FTypes[t])));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
procedure WriteVars;
|
||||||
|
var
|
||||||
|
T: Longint;
|
||||||
|
function FindType(p: Pointer): Cardinal;
|
||||||
|
var
|
||||||
|
T: Longint;
|
||||||
|
begin
|
||||||
|
Result := Cardinal(-1);
|
||||||
|
for T := 0 to i.FTypes.Count -1 do
|
||||||
|
begin
|
||||||
|
if p = i.FTypes[t] then begin
|
||||||
|
result := t;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
Writeln('[VARS]');
|
||||||
|
for t := 0 to i.FGlobalVars.count -1 do
|
||||||
|
begin
|
||||||
|
Writeln('Var ['+inttostr(t)+']: '+ IntToStr(FindType(PIFVariant(i.FGlobalVars[t])^.FType)) + ' '+ bt2s(PIFVariant(i.FGlobalVars[t])^.Ftype) + ' '+ PIFVariant(i.FGlobalVars[t])^.Ftype.ExportName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure WriteProcs;
|
||||||
|
var
|
||||||
|
t: Longint;
|
||||||
|
procedure WriteProc(proc: TPSProcRec);
|
||||||
|
var
|
||||||
|
sc, CP: Cardinal;
|
||||||
|
function ReadData(var Data; Len: Cardinal): Boolean;
|
||||||
|
begin
|
||||||
|
if CP + Len <= TPSInternalProcRec(PROC).Length then begin
|
||||||
|
Move(TPSInternalProcRec(Proc).Data[CP], Data, Len);
|
||||||
|
CP := CP + Len;
|
||||||
|
Result := True;
|
||||||
|
end else Result := False;
|
||||||
|
end;
|
||||||
|
function ReadByte(var B: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
if CP < TPSInternalProcRec(Proc).Length then begin
|
||||||
|
b := TPSInternalProcRec(Proc).Data^[cp];
|
||||||
|
Inc(CP);
|
||||||
|
Result := True;
|
||||||
|
end else Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ReadLong(var B: Cardinal): Boolean;
|
||||||
|
begin
|
||||||
|
if CP + 3 < TPSInternalProcRec(Proc).Length then begin
|
||||||
|
b := Cardinal((@TPSInternalProcRec(Proc).Data[CP])^);
|
||||||
|
Inc(CP, 4);
|
||||||
|
Result := True;
|
||||||
|
end else Result := False;
|
||||||
|
end;
|
||||||
|
function ReadWriteVariable: string;
|
||||||
|
var
|
||||||
|
VarType: byte;
|
||||||
|
L1, L2: Cardinal;
|
||||||
|
function ReadVar(FType: Cardinal): string;
|
||||||
|
var
|
||||||
|
F: PIFTypeRec;
|
||||||
|
b: byte;
|
||||||
|
w: word;
|
||||||
|
l: Cardinal;
|
||||||
|
{$IFNDEF PS_NOINT64}ff: Int64;{$ENDIF}
|
||||||
|
e: extended;
|
||||||
|
ss: single;
|
||||||
|
d: double;
|
||||||
|
s: ansistring;
|
||||||
|
c: char;
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}
|
||||||
|
wc: WideChar;
|
||||||
|
ws: WideString;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
begin
|
||||||
|
result := '';
|
||||||
|
F:= i.FTypes[Ftype];
|
||||||
|
if f = nil then exit;
|
||||||
|
case f.BaseType of
|
||||||
|
btProcPtr: begin if not ReadData(l, 4) then exit; Result := 'PROC: '+inttostr(l); end;
|
||||||
|
btU8: begin if not ReadData(b, 1) then exit; Result := IntToStr(tbtu8(B)); end;
|
||||||
|
btS8: begin if not ReadData(b, 1) then exit; Result := IntToStr(tbts8(B)); end;
|
||||||
|
btU16: begin if not ReadData(w, 2) then exit; Result := IntToStr(tbtu16(w)); end;
|
||||||
|
btS16: begin if not ReadData(w, 2) then exit; Result := IntToStr(tbts16(w)); end;
|
||||||
|
btU32: begin if not ReadData(l, 4) then exit; Result := IntToStr(tbtu32(l)); end;
|
||||||
|
btS32: begin if not ReadData(l, 4) then exit; Result := IntToStr(tbts32(l)); end;
|
||||||
|
{$IFNDEF PS_NOINT64}bts64: begin if not ReadData(ff, 8) then exit; Result := IntToStr(ff); end;{$ENDIF}
|
||||||
|
btSingle: begin if not ReadData(ss, Sizeof(tbtsingle)) then exit; Result := FloatToStr(ss); end;
|
||||||
|
btDouble: begin if not ReadData(d, Sizeof(tbtdouble)) then exit; Result := FloatToStr(d); end;
|
||||||
|
btExtended: begin if not ReadData(e, Sizeof(tbtextended)) then exit; Result := FloatToStr(e); end;
|
||||||
|
btPChar, btString: begin if not ReadData(l, 4) then exit; SetLength(s, l); if not readData(s[1], l) then exit; Result := MakeString(s); end;
|
||||||
|
btSet:
|
||||||
|
begin
|
||||||
|
SetLength(s, TPSTypeRec_Set(f).aByteSize);
|
||||||
|
if not ReadData(s[1], length(s)) then exit;
|
||||||
|
result := MakeString(s);
|
||||||
|
|
||||||
|
end;
|
||||||
|
btChar: begin if not ReadData(c, 1) then exit; Result := '#'+IntToStr(ord(c)); end;
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}
|
||||||
|
btWideChar: begin if not ReadData(wc, 2) then exit; Result := '#'+IntToStr(ord(wc)); end;
|
||||||
|
btWideString: begin if not ReadData(l, 4) then exit; SetLength(ws, l); if not readData(ws[1], l*2) then exit; Result := MakeWString(ws); end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
function AddressToStr(a: Cardinal): String;
|
||||||
|
begin
|
||||||
|
if a < PSAddrNegativeStackStart then
|
||||||
|
Result := 'GlobalVar['+inttostr(a)+']'
|
||||||
|
else
|
||||||
|
Result := 'Base['+inttostr(Longint(A-PSAddrStackStart))+']';
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
if not ReadByte(VarType) then Exit;
|
||||||
|
case VarType of
|
||||||
|
0:
|
||||||
|
begin
|
||||||
|
|
||||||
|
if not ReadLong(L1) then Exit;
|
||||||
|
Result := AddressToStr(L1);
|
||||||
|
end;
|
||||||
|
1:
|
||||||
|
begin
|
||||||
|
if not ReadLong(L1) then Exit;
|
||||||
|
Result := '['+ReadVar(l1)+']';
|
||||||
|
end;
|
||||||
|
2:
|
||||||
|
begin
|
||||||
|
if not ReadLong(L1) then Exit;
|
||||||
|
if not ReadLong(L2) then Exit;
|
||||||
|
Result := AddressToStr(L1)+'.['+inttostr(l2)+']';
|
||||||
|
end;
|
||||||
|
3:
|
||||||
|
begin
|
||||||
|
if not ReadLong(l1) then Exit;
|
||||||
|
if not ReadLong(l2) then Exit;
|
||||||
|
Result := AddressToStr(L1)+'.'+AddressToStr(l2);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
b: Byte;
|
||||||
|
s: string;
|
||||||
|
DP, D1, D2, d3, d4: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
CP := 0;
|
||||||
|
sc := 0;
|
||||||
|
while true do
|
||||||
|
begin
|
||||||
|
DP := cp;
|
||||||
|
if not ReadByte(b) then Exit;
|
||||||
|
case b of
|
||||||
|
CM_A:
|
||||||
|
begin
|
||||||
|
{$IFDEF FPC}
|
||||||
|
Output := Output + ' ['+inttostr(dp)+'] ASSIGN '+ ReadWriteVariable;
|
||||||
|
Output := Output + ', ' + ReadWriteVariable + #13#10;
|
||||||
|
{$ELSE}
|
||||||
|
Writeln(' ['+inttostr(dp)+'] ASSIGN '+ReadWriteVariable+ ', ' + ReadWriteVariable);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
CM_CA:
|
||||||
|
begin
|
||||||
|
if not ReadByte(b) then exit;
|
||||||
|
case b of
|
||||||
|
0: s:= '+';
|
||||||
|
1: s := '-';
|
||||||
|
2: s := '*';
|
||||||
|
3: s:= '/';
|
||||||
|
4: s:= 'MOD';
|
||||||
|
5: s:= 'SHL';
|
||||||
|
6: s:= 'SHR';
|
||||||
|
7: s:= 'AND';
|
||||||
|
8: s:= 'OR';
|
||||||
|
9: s:= 'XOR';
|
||||||
|
else
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] CALC '+ReadWriteVariable+ ' '+s+' ' + ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
CM_P:
|
||||||
|
begin
|
||||||
|
Inc(sc);
|
||||||
|
Writeln(' ['+inttostr(dp)+'] PUSH '+ReadWriteVariable + ' // '+inttostr(sc));
|
||||||
|
end;
|
||||||
|
CM_PV:
|
||||||
|
begin
|
||||||
|
Inc(sc);
|
||||||
|
Writeln(' ['+inttostr(dp)+'] PUSHVAR '+ReadWriteVariable + ' // '+inttostr(sc));
|
||||||
|
end;
|
||||||
|
CM_PO:
|
||||||
|
begin
|
||||||
|
Dec(Sc);
|
||||||
|
Writeln(' ['+inttostr(dp)+'] POP // '+inttostr(sc));
|
||||||
|
end;
|
||||||
|
Cm_C:
|
||||||
|
begin
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] CALL '+inttostr(d1));
|
||||||
|
end;
|
||||||
|
Cm_PG:
|
||||||
|
begin
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] POP/GOTO currpos + '+IntToStr(d1)+' ['+IntToStr(CP+d1)+']');
|
||||||
|
end;
|
||||||
|
Cm_P2G:
|
||||||
|
begin
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] POP2/GOTO currpos + '+IntToStr(d1)+' ['+IntToStr(CP+d1)+']');
|
||||||
|
end;
|
||||||
|
Cm_G:
|
||||||
|
begin
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] GOTO currpos + '+IntToStr(d1)+' ['+IntToStr(CP+d1)+']');
|
||||||
|
end;
|
||||||
|
Cm_CG:
|
||||||
|
begin
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] COND_GOTO currpos + '+IntToStr(d1)+' '+ReadWriteVariable+' ['+IntToStr(CP+d1)+']');
|
||||||
|
end;
|
||||||
|
Cm_CNG:
|
||||||
|
begin
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] COND_NOT_GOTO currpos + '+IntToStr(d1)+' '+ReadWriteVariable+' ['+IntToStr(CP+d1)+']');
|
||||||
|
end;
|
||||||
|
Cm_R: Writeln(' ['+inttostr(dp)+'] RET');
|
||||||
|
Cm_ST:
|
||||||
|
begin
|
||||||
|
if not ReadLong(d1) or not readLong(d2) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] SETSTACKTYPE Base['+inttostr(d1)+'] '+inttostr(d2));
|
||||||
|
end;
|
||||||
|
Cm_Pt:
|
||||||
|
begin
|
||||||
|
Inc(sc);
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] PUSHTYPE '+inttostr(d1) + '('+BT2S(TPSTypeRec(I.FTypes[d1]))+') // '+inttostr(sc));
|
||||||
|
end;
|
||||||
|
CM_CO:
|
||||||
|
begin
|
||||||
|
if not readByte(b) then exit;
|
||||||
|
case b of
|
||||||
|
0: s := '>=';
|
||||||
|
1: s := '<=';
|
||||||
|
2: s := '>';
|
||||||
|
3: s := '<';
|
||||||
|
4: s := '<>';
|
||||||
|
5: s := '=';
|
||||||
|
else exit;
|
||||||
|
end;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] COMPARE into '+ReadWriteVariable+': '+ReadWriteVariable+' '+s+' '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
Cm_cv:
|
||||||
|
begin
|
||||||
|
Writeln(' ['+inttostr(dp)+'] CALLVAR '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
Cm_inc:
|
||||||
|
begin
|
||||||
|
Writeln(' ['+inttostr(dp)+'] INC '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
Cm_dec:
|
||||||
|
begin
|
||||||
|
Writeln(' ['+inttostr(dp)+'] DEC '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
cm_sp:
|
||||||
|
begin
|
||||||
|
Writeln(' ['+inttostr(dp)+'] SETPOINTER '+ReadWriteVariable+': '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
cm_spc:
|
||||||
|
begin
|
||||||
|
Writeln(' ['+inttostr(dp)+'] SETCOPYPOINTER '+ReadWriteVariable+': '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
cm_in:
|
||||||
|
begin
|
||||||
|
Writeln(' ['+inttostr(dp)+'] INOT '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
cm_bn:
|
||||||
|
begin
|
||||||
|
Writeln(' ['+inttostr(dp)+'] BNOT '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
cm_vm:
|
||||||
|
begin
|
||||||
|
Writeln(' ['+inttostr(dp)+'] MINUS '+ReadWriteVariable);
|
||||||
|
end;
|
||||||
|
cm_sf:
|
||||||
|
begin
|
||||||
|
s := ReadWriteVariable;
|
||||||
|
if not ReadByte(b) then exit;
|
||||||
|
if b = 0 then
|
||||||
|
Writeln(' ['+inttostr(dp)+'] SETFLAG '+s)
|
||||||
|
else
|
||||||
|
Writeln(' ['+inttostr(dp)+'] SETFLAG NOT '+s);
|
||||||
|
end;
|
||||||
|
cm_fg:
|
||||||
|
begin
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] FLAGGOTO currpos + '+IntToStr(d1)+' ['+IntToStr(CP+d1)+']');
|
||||||
|
end;
|
||||||
|
cm_puexh:
|
||||||
|
begin
|
||||||
|
if not ReadLong(D1) then exit;
|
||||||
|
if not ReadLong(D2) then exit;
|
||||||
|
if not ReadLong(D3) then exit;
|
||||||
|
if not ReadLong(D4) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] PUSHEXCEPTION '+inttostr(d1)+' '+inttostr(d2)+' '+inttostr(d3)+' '+inttostr(d4));
|
||||||
|
end;
|
||||||
|
cm_poexh:
|
||||||
|
begin
|
||||||
|
if not ReadByte(b) then exit;
|
||||||
|
Writeln(' ['+inttostr(dp)+'] POPEXCEPTION '+inttostr(b));
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Writeln(' Disasm Error');
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Writeln('[PROCS]');
|
||||||
|
for t := 0 to i.FProcs.Count -1 do
|
||||||
|
begin
|
||||||
|
if TPSProcRec(i.FProcs[t]).ClassType = TIFExternalProcRec then
|
||||||
|
begin
|
||||||
|
if TPSExternalProcRec(i.FProcs[t]). Decl = '' then
|
||||||
|
Writeln('Proc ['+inttostr(t)+']: External: '+TPSExternalProcRec(i.FProcs[t]).Name)
|
||||||
|
else
|
||||||
|
Writeln('Proc ['+inttostr(t)+']: External Decl: '+Debug2Str(TIFExternalProcRec(i.FProcs[t]).Decl) + ' ' + TIFExternalProcRec(i.FProcs[t]).Name);
|
||||||
|
end else begin
|
||||||
|
if TPSInternalProcRec(i.FProcs[t]).ExportName <> '' then
|
||||||
|
begin
|
||||||
|
Writeln('Proc ['+inttostr(t)+'] Export: '+TPSInternalProcRec(i.FProcs[t]).ExportName+' '+TPSInternalProcRec(i.FProcs[t]).ExportDecl);
|
||||||
|
end else
|
||||||
|
Writeln('Proc ['+inttostr(t)+']');
|
||||||
|
Writeproc(i.FProcs[t]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
try
|
||||||
|
I := TMyPSExec.Create;
|
||||||
|
I.AddSpecialProcImport('', @SpecImportProc, nil);
|
||||||
|
|
||||||
|
if not I.LoadData(Input) then begin
|
||||||
|
I.Free;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Output := '';
|
||||||
|
WriteTypes;
|
||||||
|
WriteVars;
|
||||||
|
WriteProcs;
|
||||||
|
I.Free;
|
||||||
|
except
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
result := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMyIFPSExec }
|
||||||
|
|
||||||
|
function MyDummyProc(Caller: TPSExec; p: TIFExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TMyPSExec.ImportProc(const Name: ShortString;
|
||||||
|
proc: TIFExternalProcRec): Boolean;
|
||||||
|
begin
|
||||||
|
Proc.ProcPtr := MyDummyProc;
|
||||||
|
result := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SpecImportProc(Sender: TObject; p: TIFExternalProcRec): Boolean;
|
||||||
|
begin
|
||||||
|
p.ProcPtr := MyDummyProc;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
741
Units/PascalScript/uPSI_Dialogs.pas
Normal file
741
Units/PascalScript/uPSI_Dialogs.pas
Normal file
@ -0,0 +1,741 @@
|
|||||||
|
unit uPSI_Dialogs;
|
||||||
|
{
|
||||||
|
This file has been generated by UnitParser v0.5, written by M. Knight
|
||||||
|
and updated by NP. v/d Spek.
|
||||||
|
Source Code from Carlo Kok has been used to implement various sections of
|
||||||
|
UnitParser. Components of ifps3 are used in the construction of UnitParser,
|
||||||
|
code implementing the class wrapper is taken from Carlo Kok''s conv unility
|
||||||
|
}
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime;
|
||||||
|
|
||||||
|
type
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
TPSImport_Dialogs = class(TPSPlugin)
|
||||||
|
protected
|
||||||
|
procedure CompOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure ExecOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure CompileImport2(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
procedure ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows ,Messages ,CommDlg ,Graphics ,Controls ,Forms ,StdCtrls ,Dialogs;
|
||||||
|
|
||||||
|
(* === compile-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TReplaceDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TFindDialog', 'TReplaceDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TFindDialog'),'TReplaceDialog') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TFindDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCommonDialog', 'TFindDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TFindDialog') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Procedure CloseDialog');
|
||||||
|
RegisterProperty('Left', 'Integer', iptrw);
|
||||||
|
RegisterProperty('Position', 'TPoint', iptrw);
|
||||||
|
RegisterProperty('Top', 'Integer', iptrw);
|
||||||
|
RegisterProperty('FindText', 'string', iptrw);
|
||||||
|
RegisterProperty('Options', 'TFindOptions', iptrw);
|
||||||
|
RegisterProperty('OnFind', 'TNotifyEvent', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TPrintDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCommonDialog', 'TPrintDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrintDialog') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('Collate', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('Copies', 'Integer', iptrw);
|
||||||
|
RegisterProperty('FromPage', 'Integer', iptrw);
|
||||||
|
RegisterProperty('MinPage', 'Integer', iptrw);
|
||||||
|
RegisterProperty('MaxPage', 'Integer', iptrw);
|
||||||
|
RegisterProperty('Options', 'TPrintDialogOptions', iptrw);
|
||||||
|
RegisterProperty('PrintToFile', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('PrintRange', 'TPrintRange', iptrw);
|
||||||
|
RegisterProperty('ToPage', 'Integer', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TPrinterSetupDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCommonDialog', 'TPrinterSetupDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrinterSetupDialog') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TFontDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCommonDialog', 'TFontDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TFontDialog') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('Font', 'TFont', iptrw);
|
||||||
|
RegisterProperty('Device', 'TFontDialogDevice', iptrw);
|
||||||
|
RegisterProperty('MinFontSize', 'Integer', iptrw);
|
||||||
|
RegisterProperty('MaxFontSize', 'Integer', iptrw);
|
||||||
|
RegisterProperty('Options', 'TFontDialogOptions', iptrw);
|
||||||
|
RegisterProperty('OnApply', 'TFDApplyEvent', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TColorDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCommonDialog', 'TColorDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TColorDialog') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('Color', 'TColor', iptrw);
|
||||||
|
RegisterProperty('CustomColors', 'TStrings', iptrw);
|
||||||
|
RegisterProperty('Options', 'TColorDialogOptions', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TSaveDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TOpenDialog', 'TSaveDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TOpenDialog'),'TSaveDialog') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TOpenDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCommonDialog', 'TOpenDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TOpenDialog') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('FileEditStyle', 'TFileEditStyle', iptrw);
|
||||||
|
RegisterProperty('Files', 'TStrings', iptr);
|
||||||
|
RegisterProperty('HistoryList', 'TStrings', iptrw);
|
||||||
|
RegisterProperty('DefaultExt', 'string', iptrw);
|
||||||
|
RegisterProperty('FileName', 'TFileName', iptrw);
|
||||||
|
RegisterProperty('Filter', 'string', iptrw);
|
||||||
|
RegisterProperty('FilterIndex', 'Integer', iptrw);
|
||||||
|
RegisterProperty('InitialDir', 'string', iptrw);
|
||||||
|
RegisterProperty('Options', 'TOpenOptions', iptrw);
|
||||||
|
RegisterProperty('Title', 'string', iptrw);
|
||||||
|
RegisterProperty('OnCanClose', 'TCloseQueryEvent', iptrw);
|
||||||
|
RegisterProperty('OnFolderChange', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('OnSelectionChange', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('OnTypeChange', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('OnIncludeItem', 'TIncludeItemEvent', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TCommonDialog(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TComponent', 'TCommonDialog') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TComponent'),'TCommonDialog') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('Handle', 'HWnd', iptr);
|
||||||
|
RegisterProperty('Ctl3D', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('HelpContext', 'THelpContext', iptrw);
|
||||||
|
RegisterProperty('OnClose', 'TNotifyEvent', iptrw);
|
||||||
|
RegisterProperty('OnShow', 'TNotifyEvent', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_Dialogs(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
CL.AddConstantN('MaxCustomColors','LongInt').SetInt( 16);
|
||||||
|
SIRegister_TCommonDialog(CL);
|
||||||
|
CL.AddTypeS('TOpenOption', '( ofReadOnly, ofOverwritePrompt, ofHideReadOnly, '
|
||||||
|
+'ofNoChangeDir, ofShowHelp, ofNoValidate, ofAllowMultiSelect, ofExtensionDi'
|
||||||
|
+'fferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt, ofShareAware, o'
|
||||||
|
+'fNoReadOnlyReturn, ofNoTestFileCreate, ofNoNetworkButton, ofNoLongNames, o'
|
||||||
|
+'fOldStyleDialog, ofNoDereferenceLinks, ofEnableIncludeNotify, ofEnableSizi'
|
||||||
|
+'ng )');
|
||||||
|
CL.AddTypeS('TOpenOptions', 'set of TOpenOption');
|
||||||
|
CL.AddTypeS('TFileEditStyle', '( fsEdit, fsComboBox )');
|
||||||
|
CL.AddTypeS('TIncludeItemEvent', 'Procedure ( const OFN : TOFNotifyEx; var In'
|
||||||
|
+'clude : Boolean)');
|
||||||
|
SIRegister_TOpenDialog(CL);
|
||||||
|
SIRegister_TSaveDialog(CL);
|
||||||
|
CL.AddTypeS('TColorDialogOption', '( cdFullOpen, cdPreventFullOpen, cdShowHel'
|
||||||
|
+'p, cdSolidColor, cdAnyColor )');
|
||||||
|
CL.AddTypeS('TColorDialogOptions', 'set of TColorDialogOption');
|
||||||
|
SIRegister_TColorDialog(CL);
|
||||||
|
CL.AddTypeS('TFontDialogOption', '( fdAnsiOnly, fdTrueTypeOnly, fdEffects, fd'
|
||||||
|
+'FixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, fdNoSimulatio'
|
||||||
|
+'ns, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts, fdShowHelp, fdWysiwyg, fdL'
|
||||||
|
+'imitSize, fdScalableOnly, fdApplyButton )');
|
||||||
|
CL.AddTypeS('TFontDialogOptions', 'set of TFontDialogOption');
|
||||||
|
CL.AddTypeS('TFontDialogDevice', '( fdScreen, fdPrinter, fdBoth )');
|
||||||
|
CL.AddTypeS('TFDApplyEvent', 'Procedure ( Sender : TObject; Wnd : HWND)');
|
||||||
|
SIRegister_TFontDialog(CL);
|
||||||
|
SIRegister_TPrinterSetupDialog(CL);
|
||||||
|
CL.AddTypeS('TPrintRange', '( prAllPages, prSelection, prPageNums )');
|
||||||
|
CL.AddTypeS('TPrintDialogOption', '( poPrintToFile, poPageNums, poSelection, '
|
||||||
|
+'poWarning, poHelp, poDisablePrintToFile )');
|
||||||
|
CL.AddTypeS('TPrintDialogOptions', 'set of TPrintDialogOption');
|
||||||
|
SIRegister_TPrintDialog(CL);
|
||||||
|
CL.AddTypeS('TFindOption', '( frDown, frFindNext, frHideMatchCase, frHideWhol'
|
||||||
|
+'eWord, frHideUpDown, frMatchCase, frDisableMatchCase, frDisableUpDown, frD'
|
||||||
|
+'isableWholeWord, frReplace, frReplaceAll, frWholeWord, frShowHelp )');
|
||||||
|
CL.AddTypeS('TFindOptions', 'set of TFindOption');
|
||||||
|
SIRegister_TFindDialog(CL);
|
||||||
|
SIRegister_TReplaceDialog(CL);
|
||||||
|
CL.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati'
|
||||||
|
+'on, mtCustom )');
|
||||||
|
CL.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m'
|
||||||
|
+'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
|
||||||
|
CL.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
|
||||||
|
CL.AddConstantN('mbYesNoCancel','LongInt').Value.ts32 := ord(mbYes) or ord(mbNo) or ord(mbCancel);
|
||||||
|
CL.AddConstantN('mbOKCancel','LongInt').Value.ts32 := ord(mbOK) or ord(mbCancel);
|
||||||
|
CL.AddConstantN('mbAbortRetryIgnore','LongInt').Value.ts32 := ord(mbAbort) or ord(mbRetry) or ord(mbIgnore);
|
||||||
|
CL.AddDelphiFunction('Function CreateMessageDialog( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons) : TForm');
|
||||||
|
CL.AddDelphiFunction('Function MessageDlg( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint) : Integer');
|
||||||
|
CL.AddDelphiFunction('Function MessageDlgPos( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint; X, Y : Integer) : Integer');
|
||||||
|
CL.AddDelphiFunction('Function MessageDlgPosHelp( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint; X, Y : Integer; const HelpFileName : string) : Integer');
|
||||||
|
CL.AddDelphiFunction('Procedure ShowMessage( const Msg : string)');
|
||||||
|
CL.AddDelphiFunction('Procedure ShowMessagePos( const Msg : string; X, Y : Integer)');
|
||||||
|
CL.AddDelphiFunction('Function InputBox( const ACaption, APrompt, ADefault : string) : string');
|
||||||
|
CL.AddDelphiFunction('Function InputQuery( const ACaption, APrompt : string; var Value : string) : Boolean');
|
||||||
|
end;
|
||||||
|
|
||||||
|
(* === run-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogOnFind_W(Self: TFindDialog; const T: TNotifyEvent);
|
||||||
|
begin Self.OnFind := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogOnFind_R(Self: TFindDialog; var T: TNotifyEvent);
|
||||||
|
begin T := Self.OnFind; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogOptions_W(Self: TFindDialog; const T: TFindOptions);
|
||||||
|
begin Self.Options := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogOptions_R(Self: TFindDialog; var T: TFindOptions);
|
||||||
|
begin T := Self.Options; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogFindText_W(Self: TFindDialog; const T: string);
|
||||||
|
begin Self.FindText := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogFindText_R(Self: TFindDialog; var T: string);
|
||||||
|
begin T := Self.FindText; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogTop_W(Self: TFindDialog; const T: Integer);
|
||||||
|
begin Self.Top := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogTop_R(Self: TFindDialog; var T: Integer);
|
||||||
|
begin T := Self.Top; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogPosition_W(Self: TFindDialog; const T: TPoint);
|
||||||
|
begin Self.Position := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogPosition_R(Self: TFindDialog; var T: TPoint);
|
||||||
|
begin T := Self.Position; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogLeft_W(Self: TFindDialog; const T: Integer);
|
||||||
|
begin Self.Left := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFindDialogLeft_R(Self: TFindDialog; var T: Integer);
|
||||||
|
begin T := Self.Left; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogToPage_W(Self: TPrintDialog; const T: Integer);
|
||||||
|
begin Self.ToPage := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogToPage_R(Self: TPrintDialog; var T: Integer);
|
||||||
|
begin T := Self.ToPage; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogPrintRange_W(Self: TPrintDialog; const T: TPrintRange);
|
||||||
|
begin Self.PrintRange := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogPrintRange_R(Self: TPrintDialog; var T: TPrintRange);
|
||||||
|
begin T := Self.PrintRange; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogPrintToFile_W(Self: TPrintDialog; const T: Boolean);
|
||||||
|
begin Self.PrintToFile := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogPrintToFile_R(Self: TPrintDialog; var T: Boolean);
|
||||||
|
begin T := Self.PrintToFile; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogOptions_W(Self: TPrintDialog; const T: TPrintDialogOptions);
|
||||||
|
begin Self.Options := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogOptions_R(Self: TPrintDialog; var T: TPrintDialogOptions);
|
||||||
|
begin T := Self.Options; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogMaxPage_W(Self: TPrintDialog; const T: Integer);
|
||||||
|
begin Self.MaxPage := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogMaxPage_R(Self: TPrintDialog; var T: Integer);
|
||||||
|
begin T := Self.MaxPage; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogMinPage_W(Self: TPrintDialog; const T: Integer);
|
||||||
|
begin Self.MinPage := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogMinPage_R(Self: TPrintDialog; var T: Integer);
|
||||||
|
begin T := Self.MinPage; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogFromPage_W(Self: TPrintDialog; const T: Integer);
|
||||||
|
begin Self.FromPage := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogFromPage_R(Self: TPrintDialog; var T: Integer);
|
||||||
|
begin T := Self.FromPage; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogCopies_W(Self: TPrintDialog; const T: Integer);
|
||||||
|
begin Self.Copies := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogCopies_R(Self: TPrintDialog; var T: Integer);
|
||||||
|
begin T := Self.Copies; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogCollate_W(Self: TPrintDialog; const T: Boolean);
|
||||||
|
begin Self.Collate := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPrintDialogCollate_R(Self: TPrintDialog; var T: Boolean);
|
||||||
|
begin T := Self.Collate; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogOnApply_W(Self: TFontDialog; const T: TFDApplyEvent);
|
||||||
|
begin Self.OnApply := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogOnApply_R(Self: TFontDialog; var T: TFDApplyEvent);
|
||||||
|
begin T := Self.OnApply; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogOptions_W(Self: TFontDialog; const T: TFontDialogOptions);
|
||||||
|
begin Self.Options := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogOptions_R(Self: TFontDialog; var T: TFontDialogOptions);
|
||||||
|
begin T := Self.Options; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogMaxFontSize_W(Self: TFontDialog; const T: Integer);
|
||||||
|
begin Self.MaxFontSize := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogMaxFontSize_R(Self: TFontDialog; var T: Integer);
|
||||||
|
begin T := Self.MaxFontSize; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogMinFontSize_W(Self: TFontDialog; const T: Integer);
|
||||||
|
begin Self.MinFontSize := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogMinFontSize_R(Self: TFontDialog; var T: Integer);
|
||||||
|
begin T := Self.MinFontSize; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogDevice_W(Self: TFontDialog; const T: TFontDialogDevice);
|
||||||
|
begin Self.Device := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogDevice_R(Self: TFontDialog; var T: TFontDialogDevice);
|
||||||
|
begin T := Self.Device; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogFont_W(Self: TFontDialog; const T: TFont);
|
||||||
|
begin Self.Font := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TFontDialogFont_R(Self: TFontDialog; var T: TFont);
|
||||||
|
begin T := Self.Font; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TColorDialogOptions_W(Self: TColorDialog; const T: TColorDialogOptions);
|
||||||
|
begin Self.Options := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TColorDialogOptions_R(Self: TColorDialog; var T: TColorDialogOptions);
|
||||||
|
begin T := Self.Options; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TColorDialogCustomColors_W(Self: TColorDialog; const T: TStrings);
|
||||||
|
begin Self.CustomColors := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TColorDialogCustomColors_R(Self: TColorDialog; var T: TStrings);
|
||||||
|
begin T := Self.CustomColors; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TColorDialogColor_W(Self: TColorDialog; const T: TColor);
|
||||||
|
begin Self.Color := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TColorDialogColor_R(Self: TColorDialog; var T: TColor);
|
||||||
|
begin T := Self.Color; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnIncludeItem_W(Self: TOpenDialog; const T: TIncludeItemEvent);
|
||||||
|
begin Self.OnIncludeItem := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnIncludeItem_R(Self: TOpenDialog; var T: TIncludeItemEvent);
|
||||||
|
begin T := Self.OnIncludeItem; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnTypeChange_W(Self: TOpenDialog; const T: TNotifyEvent);
|
||||||
|
begin Self.OnTypeChange := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnTypeChange_R(Self: TOpenDialog; var T: TNotifyEvent);
|
||||||
|
begin T := Self.OnTypeChange; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnSelectionChange_W(Self: TOpenDialog; const T: TNotifyEvent);
|
||||||
|
begin Self.OnSelectionChange := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnSelectionChange_R(Self: TOpenDialog; var T: TNotifyEvent);
|
||||||
|
begin T := Self.OnSelectionChange; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnFolderChange_W(Self: TOpenDialog; const T: TNotifyEvent);
|
||||||
|
begin Self.OnFolderChange := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnFolderChange_R(Self: TOpenDialog; var T: TNotifyEvent);
|
||||||
|
begin T := Self.OnFolderChange; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnCanClose_W(Self: TOpenDialog; const T: TCloseQueryEvent);
|
||||||
|
begin Self.OnCanClose := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOnCanClose_R(Self: TOpenDialog; var T: TCloseQueryEvent);
|
||||||
|
begin T := Self.OnCanClose; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogTitle_W(Self: TOpenDialog; const T: string);
|
||||||
|
begin Self.Title := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogTitle_R(Self: TOpenDialog; var T: string);
|
||||||
|
begin T := Self.Title; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOptions_W(Self: TOpenDialog; const T: TOpenOptions);
|
||||||
|
begin Self.Options := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogOptions_R(Self: TOpenDialog; var T: TOpenOptions);
|
||||||
|
begin T := Self.Options; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogInitialDir_W(Self: TOpenDialog; const T: string);
|
||||||
|
begin Self.InitialDir := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogInitialDir_R(Self: TOpenDialog; var T: string);
|
||||||
|
begin T := Self.InitialDir; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFilterIndex_W(Self: TOpenDialog; const T: Integer);
|
||||||
|
begin Self.FilterIndex := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFilterIndex_R(Self: TOpenDialog; var T: Integer);
|
||||||
|
begin T := Self.FilterIndex; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFilter_W(Self: TOpenDialog; const T: string);
|
||||||
|
begin Self.Filter := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFilter_R(Self: TOpenDialog; var T: string);
|
||||||
|
begin T := Self.Filter; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFileName_W(Self: TOpenDialog; const T: TFileName);
|
||||||
|
begin Self.FileName := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFileName_R(Self: TOpenDialog; var T: TFileName);
|
||||||
|
begin T := Self.FileName; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogDefaultExt_W(Self: TOpenDialog; const T: string);
|
||||||
|
begin Self.DefaultExt := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogDefaultExt_R(Self: TOpenDialog; var T: string);
|
||||||
|
begin T := Self.DefaultExt; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogHistoryList_W(Self: TOpenDialog; const T: TStrings);
|
||||||
|
begin Self.HistoryList := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogHistoryList_R(Self: TOpenDialog; var T: TStrings);
|
||||||
|
begin T := Self.HistoryList; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFiles_R(Self: TOpenDialog; var T: TStrings);
|
||||||
|
begin T := Self.Files; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFileEditStyle_W(Self: TOpenDialog; const T: TFileEditStyle);
|
||||||
|
begin Self.FileEditStyle := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TOpenDialogFileEditStyle_R(Self: TOpenDialog; var T: TFileEditStyle);
|
||||||
|
begin T := Self.FileEditStyle; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogOnShow_W(Self: TCommonDialog; const T: TNotifyEvent);
|
||||||
|
begin Self.OnShow := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogOnShow_R(Self: TCommonDialog; var T: TNotifyEvent);
|
||||||
|
begin T := Self.OnShow; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogOnClose_W(Self: TCommonDialog; const T: TNotifyEvent);
|
||||||
|
begin Self.OnClose := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogOnClose_R(Self: TCommonDialog; var T: TNotifyEvent);
|
||||||
|
begin T := Self.OnClose; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogHelpContext_W(Self: TCommonDialog; const T: THelpContext);
|
||||||
|
begin Self.HelpContext := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogHelpContext_R(Self: TCommonDialog; var T: THelpContext);
|
||||||
|
begin T := Self.HelpContext; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogCtl3D_W(Self: TCommonDialog; const T: Boolean);
|
||||||
|
begin Self.Ctl3D := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogCtl3D_R(Self: TCommonDialog; var T: Boolean);
|
||||||
|
begin T := Self.Ctl3D; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCommonDialogHandle_R(Self: TCommonDialog; var T: HWnd);
|
||||||
|
begin T := Self.Handle; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_Dialogs_Routines(S: TPSExec);
|
||||||
|
begin
|
||||||
|
S.RegisterDelphiFunction(@CreateMessageDialog, 'CreateMessageDialog', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@MessageDlg, 'MessageDlg', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@MessageDlgPos, 'MessageDlgPos', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@MessageDlgPosHelp, 'MessageDlgPosHelp', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@ShowMessage, 'ShowMessage', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@ShowMessagePos, 'ShowMessagePos', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@InputBox, 'InputBox', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@InputQuery, 'InputQuery', cdRegister);
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TReplaceDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TReplaceDialog) do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TFindDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TFindDialog) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TFindDialog.CloseDialog, 'CloseDialog');
|
||||||
|
RegisterPropertyHelper(@TFindDialogLeft_R,@TFindDialogLeft_W,'Left');
|
||||||
|
RegisterPropertyHelper(@TFindDialogPosition_R,@TFindDialogPosition_W,'Position');
|
||||||
|
RegisterPropertyHelper(@TFindDialogTop_R,@TFindDialogTop_W,'Top');
|
||||||
|
RegisterPropertyHelper(@TFindDialogFindText_R,@TFindDialogFindText_W,'FindText');
|
||||||
|
RegisterPropertyHelper(@TFindDialogOptions_R,@TFindDialogOptions_W,'Options');
|
||||||
|
RegisterPropertyHelper(@TFindDialogOnFind_R,@TFindDialogOnFind_W,'OnFind');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TPrintDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TPrintDialog) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TPrintDialogCollate_R,@TPrintDialogCollate_W,'Collate');
|
||||||
|
RegisterPropertyHelper(@TPrintDialogCopies_R,@TPrintDialogCopies_W,'Copies');
|
||||||
|
RegisterPropertyHelper(@TPrintDialogFromPage_R,@TPrintDialogFromPage_W,'FromPage');
|
||||||
|
RegisterPropertyHelper(@TPrintDialogMinPage_R,@TPrintDialogMinPage_W,'MinPage');
|
||||||
|
RegisterPropertyHelper(@TPrintDialogMaxPage_R,@TPrintDialogMaxPage_W,'MaxPage');
|
||||||
|
RegisterPropertyHelper(@TPrintDialogOptions_R,@TPrintDialogOptions_W,'Options');
|
||||||
|
RegisterPropertyHelper(@TPrintDialogPrintToFile_R,@TPrintDialogPrintToFile_W,'PrintToFile');
|
||||||
|
RegisterPropertyHelper(@TPrintDialogPrintRange_R,@TPrintDialogPrintRange_W,'PrintRange');
|
||||||
|
RegisterPropertyHelper(@TPrintDialogToPage_R,@TPrintDialogToPage_W,'ToPage');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TPrinterSetupDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TPrinterSetupDialog) do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TFontDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TFontDialog) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TFontDialogFont_R,@TFontDialogFont_W,'Font');
|
||||||
|
RegisterPropertyHelper(@TFontDialogDevice_R,@TFontDialogDevice_W,'Device');
|
||||||
|
RegisterPropertyHelper(@TFontDialogMinFontSize_R,@TFontDialogMinFontSize_W,'MinFontSize');
|
||||||
|
RegisterPropertyHelper(@TFontDialogMaxFontSize_R,@TFontDialogMaxFontSize_W,'MaxFontSize');
|
||||||
|
RegisterPropertyHelper(@TFontDialogOptions_R,@TFontDialogOptions_W,'Options');
|
||||||
|
RegisterPropertyHelper(@TFontDialogOnApply_R,@TFontDialogOnApply_W,'OnApply');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TColorDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TColorDialog) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TColorDialogColor_R,@TColorDialogColor_W,'Color');
|
||||||
|
RegisterPropertyHelper(@TColorDialogCustomColors_R,@TColorDialogCustomColors_W,'CustomColors');
|
||||||
|
RegisterPropertyHelper(@TColorDialogOptions_R,@TColorDialogOptions_W,'Options');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TSaveDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TSaveDialog) do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TOpenDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TOpenDialog) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TOpenDialogFileEditStyle_R,@TOpenDialogFileEditStyle_W,'FileEditStyle');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogFiles_R,nil,'Files');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogHistoryList_R,@TOpenDialogHistoryList_W,'HistoryList');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogDefaultExt_R,@TOpenDialogDefaultExt_W,'DefaultExt');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogFileName_R,@TOpenDialogFileName_W,'FileName');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogFilter_R,@TOpenDialogFilter_W,'Filter');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogFilterIndex_R,@TOpenDialogFilterIndex_W,'FilterIndex');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogInitialDir_R,@TOpenDialogInitialDir_W,'InitialDir');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogOptions_R,@TOpenDialogOptions_W,'Options');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogTitle_R,@TOpenDialogTitle_W,'Title');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogOnCanClose_R,@TOpenDialogOnCanClose_W,'OnCanClose');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogOnFolderChange_R,@TOpenDialogOnFolderChange_W,'OnFolderChange');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogOnSelectionChange_R,@TOpenDialogOnSelectionChange_W,'OnSelectionChange');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogOnTypeChange_R,@TOpenDialogOnTypeChange_W,'OnTypeChange');
|
||||||
|
RegisterPropertyHelper(@TOpenDialogOnIncludeItem_R,@TOpenDialogOnIncludeItem_W,'OnIncludeItem');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TCommonDialog(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TCommonDialog) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TCommonDialogHandle_R,nil,'Handle');
|
||||||
|
RegisterPropertyHelper(@TCommonDialogCtl3D_R,@TCommonDialogCtl3D_W,'Ctl3D');
|
||||||
|
RegisterPropertyHelper(@TCommonDialogHelpContext_R,@TCommonDialogHelpContext_W,'HelpContext');
|
||||||
|
RegisterPropertyHelper(@TCommonDialogOnClose_R,@TCommonDialogOnClose_W,'OnClose');
|
||||||
|
RegisterPropertyHelper(@TCommonDialogOnShow_R,@TCommonDialogOnShow_W,'OnShow');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_Dialogs(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_TCommonDialog(CL);
|
||||||
|
RIRegister_TOpenDialog(CL);
|
||||||
|
RIRegister_TSaveDialog(CL);
|
||||||
|
RIRegister_TColorDialog(CL);
|
||||||
|
RIRegister_TFontDialog(CL);
|
||||||
|
RIRegister_TPrinterSetupDialog(CL);
|
||||||
|
RIRegister_TPrintDialog(CL);
|
||||||
|
RIRegister_TFindDialog(CL);
|
||||||
|
RIRegister_TReplaceDialog(CL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ TPSImport_Dialogs }
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Dialogs.CompOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Dialogs.ExecOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Dialogs.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
SIRegister_Dialogs(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Dialogs.CompileImport2(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Dialogs.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_Dialogs(ri);
|
||||||
|
RIRegister_Dialogs_Routines(CompExec.Exec); // comment it if no routines
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Dialogs.ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
2153
Units/PascalScript/uPSI_IBX.pas
Normal file
2153
Units/PascalScript/uPSI_IBX.pas
Normal file
File diff suppressed because it is too large
Load Diff
373
Units/PascalScript/uPSI_JvMail.pas
Normal file
373
Units/PascalScript/uPSI_JvMail.pas
Normal file
@ -0,0 +1,373 @@
|
|||||||
|
unit uPSI_JvMail;
|
||||||
|
{
|
||||||
|
This file has been generated by UnitParser v0.4b, written by M. Knight
|
||||||
|
and updated by NP. v/d Spek.
|
||||||
|
Source Code from Carlo Kok has been used to implement various sections of
|
||||||
|
UnitParser. Components of ifps3 are used in the construction of UnitParser,
|
||||||
|
code implementing the class wrapper is taken from Carlo Kok''s conv unility
|
||||||
|
}
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime;
|
||||||
|
|
||||||
|
type
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
TPSImport_JvMail = class(TPSPlugin)
|
||||||
|
protected
|
||||||
|
procedure CompOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure ExecOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure CompileImport2(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
procedure ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows
|
||||||
|
,Controls
|
||||||
|
,Forms
|
||||||
|
,Mapi
|
||||||
|
,JclBase
|
||||||
|
,JclMapi
|
||||||
|
,JvComponent
|
||||||
|
,JvMail
|
||||||
|
;
|
||||||
|
|
||||||
|
(* === compile-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TJvMail(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TJvComponent', 'TJvMail') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TComponent'),'TJvMail') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Function Address( const Caption : string; EditFields : Integer) : Boolean');
|
||||||
|
RegisterMethod('Procedure Clear');
|
||||||
|
RegisterMethod('Function ErrorCheck( Res : DWORD) : DWORD');
|
||||||
|
RegisterMethod('Function FindFirstMail : Boolean');
|
||||||
|
RegisterMethod('Function FindNextMail : Boolean');
|
||||||
|
RegisterMethod('Procedure FreeSimpleMapi');
|
||||||
|
RegisterMethod('Procedure LogOff');
|
||||||
|
RegisterMethod('Procedure LogOn');
|
||||||
|
RegisterMethod('Procedure ReadMail');
|
||||||
|
RegisterMethod('Function ResolveName( const Name : string) : string');
|
||||||
|
RegisterMethod('Function SaveMail( const MessageID : string) : string');
|
||||||
|
RegisterMethod('Procedure SendMail( ShowDialog : Boolean)');
|
||||||
|
RegisterProperty('ReadedMail', 'TJvMailReadedData', iptr);
|
||||||
|
RegisterProperty('SeedMessageID', 'string', iptrw);
|
||||||
|
RegisterProperty('SessionHandle', 'THandle', iptr);
|
||||||
|
RegisterProperty('SimpleMAPI', 'TJclSimpleMapi', iptr);
|
||||||
|
RegisterProperty('UserLogged', 'Boolean', iptr);
|
||||||
|
RegisterProperty('Attachment', 'TStrings', iptrw);
|
||||||
|
RegisterProperty('BlindCopy', 'TJvMailRecipients', iptrw);
|
||||||
|
RegisterProperty('Body', 'TStrings', iptrw);
|
||||||
|
RegisterProperty('CarbonCopy', 'TJvMailRecipients', iptrw);
|
||||||
|
RegisterProperty('LogonOptions', 'TJvMailLogonOptions', iptrw);
|
||||||
|
RegisterProperty('LongMsgId', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('Password', 'string', iptrw);
|
||||||
|
RegisterProperty('ProfileName', 'string', iptrw);
|
||||||
|
RegisterProperty('ReadOptions', 'TJvMailReadOptions', iptrw);
|
||||||
|
RegisterProperty('Recipient', 'TJvMailRecipients', iptrw);
|
||||||
|
RegisterProperty('Subject', 'string', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TJvMailRecipients(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCollection', 'TJvMailRecipients') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCollection'),'TJvMailRecipients') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor Create( AOwner : TJvMail; ARecipientClass : DWORD)');
|
||||||
|
RegisterMethod('Function Add : TJvMailRecipient');
|
||||||
|
RegisterMethod('Function AddRecipient( const Address : string; const Name : string) : Integer');
|
||||||
|
RegisterProperty('Items', 'TJvMailRecipient Integer', iptrw);
|
||||||
|
SetDefaultPropery('Items');
|
||||||
|
RegisterProperty('RecipientClass', 'DWORD', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TJvMailRecipient(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCollectionItem', 'TJvMailRecipient') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCollectionItem'),'TJvMailRecipient') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('AddressAndName', 'string', iptr);
|
||||||
|
RegisterProperty('Address', 'string', iptrw);
|
||||||
|
RegisterProperty('Name', 'string', iptrw);
|
||||||
|
RegisterProperty('Valid', 'Boolean', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_JvMail(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
CL.AddClassN(CL.FindClass('TOBJECT'),'TJvMail');
|
||||||
|
SIRegister_TJvMailRecipient(CL);
|
||||||
|
SIRegister_TJvMailRecipients(CL);
|
||||||
|
CL.AddTypeS('TJvMailLogonOption', '( loLogonUI, loNewSession )');
|
||||||
|
CL.AddTypeS('TJvMailReadOption', '( roUnreadOnly, roFifo, roPeek, roHeaderOnl'
|
||||||
|
+'y, roAttachments )');
|
||||||
|
CL.AddTypeS('TJvMailLogonOptions', 'set of TJvMailLogonOption');
|
||||||
|
CL.AddTypeS('TJvMailReadOptions', 'set of TJvMailReadOption');
|
||||||
|
CL.AddTypeS('TJvMailReadedData', 'record RecipientAddress : string; Recipient'
|
||||||
|
+'Name : string; ConversationID : string; DateReceived : TDateTime; end');
|
||||||
|
SIRegister_TJvMail(CL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
(* === run-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailSubject_W(Self: TJvMail; const T: string);
|
||||||
|
begin Self.Subject := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailSubject_R(Self: TJvMail; var T: string);
|
||||||
|
begin T := Self.Subject; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipient_W(Self: TJvMail; const T: TJvMailRecipients);
|
||||||
|
begin Self.Recipient := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipient_R(Self: TJvMail; var T: TJvMailRecipients);
|
||||||
|
begin T := Self.Recipient; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailReadOptions_W(Self: TJvMail; const T: TJvMailReadOptions);
|
||||||
|
begin Self.ReadOptions := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailReadOptions_R(Self: TJvMail; var T: TJvMailReadOptions);
|
||||||
|
begin T := Self.ReadOptions; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailProfileName_W(Self: TJvMail; const T: string);
|
||||||
|
begin Self.ProfileName := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailProfileName_R(Self: TJvMail; var T: string);
|
||||||
|
begin T := Self.ProfileName; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailPassword_W(Self: TJvMail; const T: string);
|
||||||
|
begin Self.Password := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailPassword_R(Self: TJvMail; var T: string);
|
||||||
|
begin T := Self.Password; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailLongMsgId_W(Self: TJvMail; const T: Boolean);
|
||||||
|
begin Self.LongMsgId := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailLongMsgId_R(Self: TJvMail; var T: Boolean);
|
||||||
|
begin T := Self.LongMsgId; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailLogonOptions_W(Self: TJvMail; const T: TJvMailLogonOptions);
|
||||||
|
begin Self.LogonOptions := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailLogonOptions_R(Self: TJvMail; var T: TJvMailLogonOptions);
|
||||||
|
begin T := Self.LogonOptions; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailCarbonCopy_W(Self: TJvMail; const T: TJvMailRecipients);
|
||||||
|
begin Self.CarbonCopy := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailCarbonCopy_R(Self: TJvMail; var T: TJvMailRecipients);
|
||||||
|
begin T := Self.CarbonCopy; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailBody_W(Self: TJvMail; const T: TStrings);
|
||||||
|
begin Self.Body := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailBody_R(Self: TJvMail; var T: TStrings);
|
||||||
|
begin T := Self.Body; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailBlindCopy_W(Self: TJvMail; const T: TJvMailRecipients);
|
||||||
|
begin Self.BlindCopy := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailBlindCopy_R(Self: TJvMail; var T: TJvMailRecipients);
|
||||||
|
begin T := Self.BlindCopy; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailAttachment_W(Self: TJvMail; const T: TStrings);
|
||||||
|
begin Self.Attachment := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailAttachment_R(Self: TJvMail; var T: TStrings);
|
||||||
|
begin T := Self.Attachment; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailUserLogged_R(Self: TJvMail; var T: Boolean);
|
||||||
|
begin T := Self.UserLogged; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailSimpleMAPI_R(Self: TJvMail; var T: TJclSimpleMapi);
|
||||||
|
begin T := Self.SimpleMAPI; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailSessionHandle_R(Self: TJvMail; var T: THandle);
|
||||||
|
begin T := Self.SessionHandle; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailSeedMessageID_W(Self: TJvMail; const T: string);
|
||||||
|
begin Self.SeedMessageID := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailSeedMessageID_R(Self: TJvMail; var T: string);
|
||||||
|
begin T := Self.SeedMessageID; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailReadedMail_R(Self: TJvMail; var T: TJvMailReadedData);
|
||||||
|
begin T := Self.ReadedMail; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientsRecipientClass_R(Self: TJvMailRecipients; var T: DWORD);
|
||||||
|
begin T := Self.RecipientClass; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientsItems_W(Self: TJvMailRecipients; const T: TJvMailRecipient; const t1: Integer);
|
||||||
|
begin Self.Items[t1] := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientsItems_R(Self: TJvMailRecipients; var T: TJvMailRecipient; const t1: Integer);
|
||||||
|
begin T := Self.Items[t1]; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientValid_R(Self: TJvMailRecipient; var T: Boolean);
|
||||||
|
begin T := Self.Valid; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientName_W(Self: TJvMailRecipient; const T: string);
|
||||||
|
begin Self.Name := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientName_R(Self: TJvMailRecipient; var T: string);
|
||||||
|
begin T := Self.Name; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientAddress_W(Self: TJvMailRecipient; const T: string);
|
||||||
|
begin Self.Address := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientAddress_R(Self: TJvMailRecipient; var T: string);
|
||||||
|
begin T := Self.Address; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TJvMailRecipientAddressAndName_R(Self: TJvMailRecipient; var T: string);
|
||||||
|
begin T := Self.AddressAndName; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TJvMail(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TJvMail) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TJvMail.Address, 'Address');
|
||||||
|
RegisterMethod(@TJvMail.Clear, 'Clear');
|
||||||
|
RegisterMethod(@TJvMail.ErrorCheck, 'ErrorCheck');
|
||||||
|
RegisterMethod(@TJvMail.FindFirstMail, 'FindFirstMail');
|
||||||
|
RegisterMethod(@TJvMail.FindNextMail, 'FindNextMail');
|
||||||
|
RegisterMethod(@TJvMail.FreeSimpleMapi, 'FreeSimpleMapi');
|
||||||
|
RegisterMethod(@TJvMail.LogOff, 'LogOff');
|
||||||
|
RegisterMethod(@TJvMail.LogOn, 'LogOn');
|
||||||
|
RegisterMethod(@TJvMail.ReadMail, 'ReadMail');
|
||||||
|
RegisterMethod(@TJvMail.ResolveName, 'ResolveName');
|
||||||
|
RegisterMethod(@TJvMail.SaveMail, 'SaveMail');
|
||||||
|
RegisterMethod(@TJvMail.SendMail, 'SendMail');
|
||||||
|
RegisterPropertyHelper(@TJvMailReadedMail_R,nil,'ReadedMail');
|
||||||
|
RegisterPropertyHelper(@TJvMailSeedMessageID_R,@TJvMailSeedMessageID_W,'SeedMessageID');
|
||||||
|
RegisterPropertyHelper(@TJvMailSessionHandle_R,nil,'SessionHandle');
|
||||||
|
RegisterPropertyHelper(@TJvMailSimpleMAPI_R,nil,'SimpleMAPI');
|
||||||
|
RegisterPropertyHelper(@TJvMailUserLogged_R,nil,'UserLogged');
|
||||||
|
RegisterPropertyHelper(@TJvMailAttachment_R,@TJvMailAttachment_W,'Attachment');
|
||||||
|
RegisterPropertyHelper(@TJvMailBlindCopy_R,@TJvMailBlindCopy_W,'BlindCopy');
|
||||||
|
RegisterPropertyHelper(@TJvMailBody_R,@TJvMailBody_W,'Body');
|
||||||
|
RegisterPropertyHelper(@TJvMailCarbonCopy_R,@TJvMailCarbonCopy_W,'CarbonCopy');
|
||||||
|
RegisterPropertyHelper(@TJvMailLogonOptions_R,@TJvMailLogonOptions_W,'LogonOptions');
|
||||||
|
RegisterPropertyHelper(@TJvMailLongMsgId_R,@TJvMailLongMsgId_W,'LongMsgId');
|
||||||
|
RegisterPropertyHelper(@TJvMailPassword_R,@TJvMailPassword_W,'Password');
|
||||||
|
RegisterPropertyHelper(@TJvMailProfileName_R,@TJvMailProfileName_W,'ProfileName');
|
||||||
|
RegisterPropertyHelper(@TJvMailReadOptions_R,@TJvMailReadOptions_W,'ReadOptions');
|
||||||
|
RegisterPropertyHelper(@TJvMailRecipient_R,@TJvMailRecipient_W,'Recipient');
|
||||||
|
RegisterPropertyHelper(@TJvMailSubject_R,@TJvMailSubject_W,'Subject');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TJvMailRecipients(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TJvMailRecipients) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TJvMailRecipients.Create, 'Create');
|
||||||
|
RegisterMethod(@TJvMailRecipients.Add, 'Add');
|
||||||
|
RegisterMethod(@TJvMailRecipients.AddRecipient, 'AddRecipient');
|
||||||
|
RegisterPropertyHelper(@TJvMailRecipientsItems_R,@TJvMailRecipientsItems_W,'Items');
|
||||||
|
RegisterPropertyHelper(@TJvMailRecipientsRecipientClass_R,nil,'RecipientClass');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TJvMailRecipient(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TJvMailRecipient) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TJvMailRecipientAddressAndName_R,nil,'AddressAndName');
|
||||||
|
RegisterPropertyHelper(@TJvMailRecipientAddress_R,@TJvMailRecipientAddress_W,'Address');
|
||||||
|
RegisterPropertyHelper(@TJvMailRecipientName_R,@TJvMailRecipientName_W,'Name');
|
||||||
|
RegisterPropertyHelper(@TJvMailRecipientValid_R,nil,'Valid');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_JvMail(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TJvMail) do
|
||||||
|
RIRegister_TJvMailRecipient(CL);
|
||||||
|
RIRegister_TJvMailRecipients(CL);
|
||||||
|
RIRegister_TJvMail(CL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSImport_JvMail }
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_JvMail.CompOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_JvMail.ExecOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_JvMail.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
SIRegister_JvMail(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_JvMail.CompileImport2(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_JvMail.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_JvMail(ri);
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_JvMail.ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
187
Units/PascalScript/uPSI_Mask.pas
Normal file
187
Units/PascalScript/uPSI_Mask.pas
Normal file
@ -0,0 +1,187 @@
|
|||||||
|
unit uPSI_Mask;
|
||||||
|
{
|
||||||
|
This file has been generated by UnitParser v0.5, written by M. Knight
|
||||||
|
and updated by NP. v/d Spek.
|
||||||
|
Source Code from Carlo Kok has been used to implement various sections of
|
||||||
|
UnitParser. Components of ifps3 are used in the construction of UnitParser,
|
||||||
|
code implementing the class wrapper is taken from Carlo Kok''s conv unility
|
||||||
|
}
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime;
|
||||||
|
|
||||||
|
type
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
TPSImport_Mask = class(TPSPlugin)
|
||||||
|
protected
|
||||||
|
procedure CompOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure ExecOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure CompileImport2(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
procedure ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows ,StdCtrls ,Controls ,Messages ,Forms ,Graphics ,Menus ,Mask;
|
||||||
|
|
||||||
|
(* === compile-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TMaskEdit(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCustomMaskEdit', 'TMaskEdit') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCustomMaskEdit'),'TMaskEdit') do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TCustomMaskEdit(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCustomEdit', 'TCustomMaskEdit') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCustomEdit'),'TCustomMaskEdit') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Procedure ValidateEdit');
|
||||||
|
RegisterMethod('Function GetTextLen : Integer');
|
||||||
|
RegisterProperty('IsMasked', 'Boolean', iptr);
|
||||||
|
RegisterProperty('EditText', 'string', iptrw);
|
||||||
|
RegisterProperty('Text', 'string', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_Mask(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
CL.AddConstantN('DefaultBlank','Char').SetString( '_');
|
||||||
|
CL.AddConstantN('MaskFieldSeparator','Char').SetString( ';');
|
||||||
|
CL.AddConstantN('MaskNoSave','Char').SetString( '0');
|
||||||
|
CL.AddConstantN('mDirReverse','String').SetString( '!');
|
||||||
|
CL.AddConstantN('mDirUpperCase','String').SetString( '>');
|
||||||
|
CL.AddConstantN('mDirLowerCase','String').SetString( '<');
|
||||||
|
CL.AddConstantN('mDirLiteral','String').SetString( '\');
|
||||||
|
CL.AddConstantN('mMskAlpha','String').SetString( 'L');
|
||||||
|
CL.AddConstantN('mMskAlphaOpt','String').SetString( 'l');
|
||||||
|
CL.AddConstantN('mMskAlphaNum','String').SetString( 'A');
|
||||||
|
CL.AddConstantN('mMskAlphaNumOpt','String').SetString( 'a');
|
||||||
|
CL.AddConstantN('mMskAscii','String').SetString( 'C');
|
||||||
|
CL.AddConstantN('mMskAsciiOpt','String').SetString( 'c');
|
||||||
|
CL.AddConstantN('mMskNumeric','String').SetString( '0');
|
||||||
|
CL.AddConstantN('mMskNumericOpt','String').SetString( '9');
|
||||||
|
CL.AddConstantN('mMskNumSymOpt','String').SetString( '#');
|
||||||
|
CL.AddConstantN('mMskTimeSeparator','String').SetString( ':');
|
||||||
|
CL.AddConstantN('mMskDateSeparator','String').SetString( '/');
|
||||||
|
CL.AddTypeS('TMaskCharType', '( mcNone, mcLiteral, mcIntlLiteral, mcDirective'
|
||||||
|
+', mcMask, mcMaskOpt, mcFieldSeparator, mcField )');
|
||||||
|
CL.AddTypeS('TMaskDirective', '( mdReverseDir, mdUpperCase, mdLowerCa'
|
||||||
|
+'se, mdLiteralChar )');
|
||||||
|
CL.AddTypeS('TMaskDirectives', 'set of TMaskDirective');
|
||||||
|
CL.AddClassN(CL.FindClass('TOBJECT'),'EDBEditError');
|
||||||
|
CL.AddTypeS('TMaskedStatex', '( msMasked, msReEnter, msDBSetText )');
|
||||||
|
CL.AddTypeS('TMaskedState', 'set of TMaskedStatex');
|
||||||
|
SIRegister_TCustomMaskEdit(CL);
|
||||||
|
SIRegister_TMaskEdit(CL);
|
||||||
|
CL.AddDelphiFunction('Function FormatMaskText( const EditMask : string; const Value : string) : string');
|
||||||
|
CL.AddDelphiFunction('Function MaskGetMaskSave( const EditMask : string) : Boolean');
|
||||||
|
CL.AddDelphiFunction('Function MaskGetMaskBlank( const EditMask : string) : Char');
|
||||||
|
CL.AddDelphiFunction('Function MaskGetFldSeparator( const EditMask : string) : Integer');
|
||||||
|
end;
|
||||||
|
|
||||||
|
(* === run-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCustomMaskEditText_W(Self: TCustomMaskEdit; const T: string);
|
||||||
|
begin Self.Text := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCustomMaskEditText_R(Self: TCustomMaskEdit; var T: string);
|
||||||
|
begin T := Self.Text; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCustomMaskEditEditText_W(Self: TCustomMaskEdit; const T: string);
|
||||||
|
begin Self.EditText := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCustomMaskEditEditText_R(Self: TCustomMaskEdit; var T: string);
|
||||||
|
begin T := Self.EditText; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCustomMaskEditIsMasked_R(Self: TCustomMaskEdit; var T: Boolean);
|
||||||
|
begin T := Self.IsMasked; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_Mask_Routines(S: TPSExec);
|
||||||
|
begin
|
||||||
|
S.RegisterDelphiFunction(@FormatMaskText, 'FormatMaskText', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@MaskGetMaskSave, 'MaskGetMaskSave', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@MaskGetMaskBlank, 'MaskGetMaskBlank', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@MaskGetFldSeparator, 'MaskGetFldSeparator', cdRegister);
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TMaskEdit(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TMaskEdit) do
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TCustomMaskEdit(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TCustomMaskEdit) do
|
||||||
|
begin
|
||||||
|
RegisterVirtualMethod(@TCustomMaskEdit.ValidateEdit, 'ValidateEdit');
|
||||||
|
RegisterMethod(@TCustomMaskEdit.GetTextLen, 'GetTextLen');
|
||||||
|
RegisterPropertyHelper(@TCustomMaskEditIsMasked_R,nil,'IsMasked');
|
||||||
|
RegisterPropertyHelper(@TCustomMaskEditEditText_R,@TCustomMaskEditEditText_W,'EditText');
|
||||||
|
RegisterPropertyHelper(@TCustomMaskEditText_R,@TCustomMaskEditText_W,'Text');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_Mask(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(EDBEditError) do
|
||||||
|
RIRegister_TCustomMaskEdit(CL);
|
||||||
|
RIRegister_TMaskEdit(CL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ TPSImport_Mask }
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Mask.CompOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Mask.ExecOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Mask.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
SIRegister_Mask(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Mask.CompileImport2(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Mask.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_Mask(ri);
|
||||||
|
RIRegister_Mask_Routines(CompExec.Exec); // comment it if no routines
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Mask.ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
478
Units/PascalScript/uPSI_Registry.pas
Normal file
478
Units/PascalScript/uPSI_Registry.pas
Normal file
@ -0,0 +1,478 @@
|
|||||||
|
unit uPSI_Registry;
|
||||||
|
{
|
||||||
|
This file has been generated by UnitParser v0.4b, written by M. Knight
|
||||||
|
and updated by NP. v/d Spek.
|
||||||
|
Source Code from Carlo Kok has been used to implement various sections of
|
||||||
|
UnitParser. Components of ifps3 are used in the construction of UnitParser,
|
||||||
|
code implementing the class wrapper is taken from Carlo Kok''s conv unility
|
||||||
|
}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime;
|
||||||
|
|
||||||
|
type
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
TPSImport_Registry = class(TPSPlugin)
|
||||||
|
protected
|
||||||
|
procedure CompOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure ExecOnUses(CompExec: TPSScript); override;
|
||||||
|
procedure CompileImport1(CompExec: TPSScript); override;
|
||||||
|
procedure CompileImport2(CompExec: TPSScript); override;
|
||||||
|
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
procedure ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows ,IniFiles ,Registry ;
|
||||||
|
|
||||||
|
(* === compile-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TRegistryIniFile(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCustomIniFile', 'TRegistryIniFile') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCustomIniFile'),'TRegistryIniFile') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor Create( const FileName : string);');
|
||||||
|
RegisterMethod('Constructor CreateA( const FileName : string; AAccess : LongWord);');
|
||||||
|
RegisterProperty('RegIniFile', 'TRegIniFile', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TRegIniFile(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TRegistry', 'TRegIniFile') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TRegistry'),'TRegIniFile') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor Create( const FileName : string);');
|
||||||
|
RegisterMethod('Constructor CreateA( const FileName : string; AAccess : LongWord);');
|
||||||
|
RegisterMethod('Function ReadString( const Section, Ident, Default : string) : string');
|
||||||
|
RegisterMethod('Function ReadInteger( const Section, Ident : string; Default : Longint) : Longint');
|
||||||
|
RegisterMethod('Procedure WriteInteger( const Section, Ident : string; Value : Longint)');
|
||||||
|
RegisterMethod('Procedure WriteString( const Section, Ident, Value : String)');
|
||||||
|
RegisterMethod('Function ReadBool( const Section, Ident : string; Default : Boolean) : Boolean');
|
||||||
|
RegisterMethod('Procedure WriteBool( const Section, Ident : string; Value : Boolean)');
|
||||||
|
RegisterMethod('Procedure ReadSection( const Section : string; Strings : TStrings)');
|
||||||
|
RegisterMethod('Procedure ReadSections( Strings : TStrings)');
|
||||||
|
RegisterMethod('Procedure ReadSectionValues( const Section : string; Strings : TStrings)');
|
||||||
|
RegisterMethod('Procedure EraseSection( const Section : string)');
|
||||||
|
RegisterMethod('Procedure DeleteKey( const Section, Ident : String)');
|
||||||
|
RegisterProperty('FileName', 'string', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TRegistry(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TObject', 'TRegistry') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TObject'),'TRegistry') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor Create;');
|
||||||
|
RegisterMethod('Constructor CreateA( AAccess : LongWord);');
|
||||||
|
RegisterMethod('Procedure CloseKey');
|
||||||
|
RegisterMethod('Function CreateKey( const Key : string) : Boolean');
|
||||||
|
RegisterMethod('Function DeleteKey( const Key : string) : Boolean');
|
||||||
|
RegisterMethod('Function DeleteValue( const Name : string) : Boolean');
|
||||||
|
RegisterMethod('Function GetDataInfo( const ValueName : string; var Value : TRegDataInfo) : Boolean');
|
||||||
|
RegisterMethod('Function GetDataSize( const ValueName : string) : Integer');
|
||||||
|
RegisterMethod('Function GetDataType( const ValueName : string) : TRegDataType');
|
||||||
|
RegisterMethod('Function GetKeyInfo( var Value : TRegKeyInfo) : Boolean');
|
||||||
|
RegisterMethod('Procedure GetKeyNames( Strings : TStrings)');
|
||||||
|
RegisterMethod('Procedure GetValueNames( Strings : TStrings)');
|
||||||
|
RegisterMethod('Function HasSubKeys : Boolean');
|
||||||
|
RegisterMethod('Function KeyExists( const Key : string) : Boolean');
|
||||||
|
RegisterMethod('Function LoadKey( const Key, FileName : string) : Boolean');
|
||||||
|
RegisterMethod('Procedure MoveKey( const OldName, NewName : string; Delete : Boolean)');
|
||||||
|
RegisterMethod('Function OpenKey( const Key : string; CanCreate : Boolean) : Boolean');
|
||||||
|
RegisterMethod('Function OpenKeyReadOnly( const Key : String) : Boolean');
|
||||||
|
RegisterMethod('Function ReadCurrency( const Name : string) : Currency');
|
||||||
|
RegisterMethod('Function ReadBool( const Name : string) : Boolean');
|
||||||
|
RegisterMethod('Function ReadDate( const Name : string) : TDateTime');
|
||||||
|
RegisterMethod('Function ReadDateTime( const Name : string) : TDateTime');
|
||||||
|
RegisterMethod('Function ReadFloat( const Name : string) : Double');
|
||||||
|
RegisterMethod('Function ReadInteger( const Name : string) : Integer');
|
||||||
|
RegisterMethod('Function ReadString( const Name : string) : string');
|
||||||
|
RegisterMethod('Function ReadTime( const Name : string) : TDateTime');
|
||||||
|
RegisterMethod('Function RegistryConnect( const UNCName : string) : Boolean');
|
||||||
|
RegisterMethod('Procedure RenameValue( const OldName, NewName : string)');
|
||||||
|
RegisterMethod('Function ReplaceKey( const Key, FileName, BackUpFileName : string) : Boolean');
|
||||||
|
RegisterMethod('Function RestoreKey( const Key, FileName : string) : Boolean');
|
||||||
|
RegisterMethod('Function SaveKey( const Key, FileName : string) : Boolean');
|
||||||
|
RegisterMethod('Function UnLoadKey( const Key : string) : Boolean');
|
||||||
|
RegisterMethod('Function ValueExists( const Name : string) : Boolean');
|
||||||
|
RegisterMethod('Procedure WriteCurrency( const Name : string; Value : Currency)');
|
||||||
|
RegisterMethod('Procedure WriteBool( const Name : string; Value : Boolean)');
|
||||||
|
RegisterMethod('Procedure WriteDate( const Name : string; Value : TDateTime)');
|
||||||
|
RegisterMethod('Procedure WriteDateTime( const Name : string; Value : TDateTime)');
|
||||||
|
RegisterMethod('Procedure WriteFloat( const Name : string; Value : Double)');
|
||||||
|
RegisterMethod('Procedure WriteInteger( const Name : string; Value : Integer)');
|
||||||
|
RegisterMethod('Procedure WriteString( const Name, Value : string)');
|
||||||
|
RegisterMethod('Procedure WriteExpandString( const Name, Value : string)');
|
||||||
|
RegisterMethod('Procedure WriteTime( const Name : string; Value : TDateTime)');
|
||||||
|
RegisterProperty('CurrentKey', 'HKEY', iptr);
|
||||||
|
RegisterProperty('CurrentPath', 'string', iptr);
|
||||||
|
RegisterProperty('LazyWrite', 'Boolean', iptrw);
|
||||||
|
RegisterProperty('RootKey', 'HKEY', iptrw);
|
||||||
|
RegisterProperty('Access', 'LongWord', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_Registry(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
CL.AddClassN(CL.FindClass('TOBJECT'),'ERegistryException');
|
||||||
|
SIRegister_TRegistry(CL);
|
||||||
|
SIRegister_TRegIniFile(CL);
|
||||||
|
SIRegister_TRegistryIniFile(CL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
(* === run-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryIniFileRegIniFile_R(Self: TRegistryIniFile; var T: TRegIniFile);
|
||||||
|
begin T := Self.RegIniFile; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
Function TRegistryIniFileCreateA_P(Self: TClass; CreateNewInstance: Boolean; const FileName : string; AAccess : LongWord):TObject;
|
||||||
|
Begin Result := TRegistryIniFile.Create(FileName, AAccess); END;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
Function TRegistryIniFileCreate_P(Self: TClass; CreateNewInstance: Boolean; const FileName : string):TObject;
|
||||||
|
Begin Result := TRegistryIniFile.Create(FileName); END;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegIniFileFileName_R(Self: TRegIniFile; var T: string);
|
||||||
|
begin T := Self.FileName; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
Function TRegIniFileCreateA_P(Self: TClass; CreateNewInstance: Boolean; const FileName : string; AAccess : LongWord):TObject;
|
||||||
|
Begin Result := TRegIniFile.Create(FileName, AAccess); END;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
Function TRegIniFileCreate_P(Self: TClass; CreateNewInstance: Boolean; const FileName : string):TObject;
|
||||||
|
Begin Result := TRegIniFile.Create(FileName); END;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryAccess_W(Self: TRegistry; const T: LongWord);
|
||||||
|
begin Self.Access := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryAccess_R(Self: TRegistry; var T: LongWord);
|
||||||
|
begin T := Self.Access; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryRootKey_W(Self: TRegistry; const T: HKEY);
|
||||||
|
begin Self.RootKey := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryRootKey_R(Self: TRegistry; var T: HKEY);
|
||||||
|
begin T := Self.RootKey; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryLazyWrite_W(Self: TRegistry; const T: Boolean);
|
||||||
|
begin Self.LazyWrite := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryLazyWrite_R(Self: TRegistry; var T: Boolean);
|
||||||
|
begin T := Self.LazyWrite; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryCurrentPath_R(Self: TRegistry; var T: string);
|
||||||
|
begin T := Self.CurrentPath; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TRegistryCurrentKey_R(Self: TRegistry; var T: HKEY);
|
||||||
|
begin T := Self.CurrentKey; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
Function TRegistryCreateA_P(Self: TClass; CreateNewInstance: Boolean; AAccess : LongWord):TObject;
|
||||||
|
Begin Result := TRegistry.Create(AAccess); END;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
Function TRegistryCreate_P(Self: TClass; CreateNewInstance: Boolean):TObject;
|
||||||
|
Begin Result := TRegistry.Create; END;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TRegistryIniFile(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TRegistryIniFile) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TRegistryIniFileCreate_P, 'Create');
|
||||||
|
RegisterConstructor(@TRegistryIniFileCreateA_P, 'CreateA');
|
||||||
|
RegisterPropertyHelper(@TRegistryIniFileRegIniFile_R,nil,'RegIniFile');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TRegIniFile(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TRegIniFile) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TRegIniFileCreate_P, 'Create');
|
||||||
|
RegisterConstructor(@TRegIniFileCreateA_P, 'CreateA');
|
||||||
|
RegisterMethod(@TRegIniFile.ReadString, 'ReadString');
|
||||||
|
RegisterMethod(@TRegIniFile.ReadInteger, 'ReadInteger');
|
||||||
|
RegisterMethod(@TRegIniFile.WriteInteger, 'WriteInteger');
|
||||||
|
RegisterMethod(@TRegIniFile.WriteString, 'WriteString');
|
||||||
|
RegisterMethod(@TRegIniFile.ReadBool, 'ReadBool');
|
||||||
|
RegisterMethod(@TRegIniFile.WriteBool, 'WriteBool');
|
||||||
|
RegisterMethod(@TRegIniFile.ReadSection, 'ReadSection');
|
||||||
|
RegisterMethod(@TRegIniFile.ReadSections, 'ReadSections');
|
||||||
|
RegisterMethod(@TRegIniFile.ReadSectionValues, 'ReadSectionValues');
|
||||||
|
RegisterMethod(@TRegIniFile.EraseSection, 'EraseSection');
|
||||||
|
RegisterMethod(@TRegIniFile.DeleteKey, 'DeleteKey');
|
||||||
|
RegisterPropertyHelper(@TRegIniFileFileName_R,nil,'FileName');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TRegistry(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TRegistry) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TRegistryCreateA_P, 'CreateA');
|
||||||
|
RegisterConstructor(@TRegistryCreate_P, 'Create');
|
||||||
|
RegisterMethod(@TRegistry.CloseKey, 'CloseKey');
|
||||||
|
RegisterMethod(@TRegistry.CreateKey, 'CreateKey');
|
||||||
|
RegisterMethod(@TRegistry.DeleteKey, 'DeleteKey');
|
||||||
|
RegisterMethod(@TRegistry.DeleteValue, 'DeleteValue');
|
||||||
|
RegisterMethod(@TRegistry.GetDataInfo, 'GetDataInfo');
|
||||||
|
RegisterMethod(@TRegistry.GetDataSize, 'GetDataSize');
|
||||||
|
RegisterMethod(@TRegistry.GetDataType, 'GetDataType');
|
||||||
|
RegisterMethod(@TRegistry.GetKeyInfo, 'GetKeyInfo');
|
||||||
|
RegisterMethod(@TRegistry.GetKeyNames, 'GetKeyNames');
|
||||||
|
RegisterMethod(@TRegistry.GetValueNames, 'GetValueNames');
|
||||||
|
RegisterMethod(@TRegistry.HasSubKeys, 'HasSubKeys');
|
||||||
|
RegisterMethod(@TRegistry.KeyExists, 'KeyExists');
|
||||||
|
RegisterMethod(@TRegistry.LoadKey, 'LoadKey');
|
||||||
|
RegisterMethod(@TRegistry.MoveKey, 'MoveKey');
|
||||||
|
RegisterMethod(@TRegistry.OpenKey, 'OpenKey');
|
||||||
|
RegisterMethod(@TRegistry.OpenKeyReadOnly, 'OpenKeyReadOnly');
|
||||||
|
RegisterMethod(@TRegistry.ReadCurrency, 'ReadCurrency');
|
||||||
|
RegisterMethod(@TRegistry.ReadBool, 'ReadBool');
|
||||||
|
RegisterMethod(@TRegistry.ReadDate, 'ReadDate');
|
||||||
|
RegisterMethod(@TRegistry.ReadDateTime, 'ReadDateTime');
|
||||||
|
RegisterMethod(@TRegistry.ReadFloat, 'ReadFloat');
|
||||||
|
RegisterMethod(@TRegistry.ReadInteger, 'ReadInteger');
|
||||||
|
RegisterMethod(@TRegistry.ReadString, 'ReadString');
|
||||||
|
RegisterMethod(@TRegistry.ReadTime, 'ReadTime');
|
||||||
|
RegisterMethod(@TRegistry.RegistryConnect, 'RegistryConnect');
|
||||||
|
RegisterMethod(@TRegistry.RenameValue, 'RenameValue');
|
||||||
|
RegisterMethod(@TRegistry.ReplaceKey, 'ReplaceKey');
|
||||||
|
RegisterMethod(@TRegistry.RestoreKey, 'RestoreKey');
|
||||||
|
RegisterMethod(@TRegistry.SaveKey, 'SaveKey');
|
||||||
|
RegisterMethod(@TRegistry.UnLoadKey, 'UnLoadKey');
|
||||||
|
RegisterMethod(@TRegistry.ValueExists, 'ValueExists');
|
||||||
|
RegisterMethod(@TRegistry.WriteCurrency, 'WriteCurrency');
|
||||||
|
RegisterMethod(@TRegistry.WriteBool, 'WriteBool');
|
||||||
|
RegisterMethod(@TRegistry.WriteDate, 'WriteDate');
|
||||||
|
RegisterMethod(@TRegistry.WriteDateTime, 'WriteDateTime');
|
||||||
|
RegisterMethod(@TRegistry.WriteFloat, 'WriteFloat');
|
||||||
|
RegisterMethod(@TRegistry.WriteInteger, 'WriteInteger');
|
||||||
|
RegisterMethod(@TRegistry.WriteString, 'WriteString');
|
||||||
|
RegisterMethod(@TRegistry.WriteExpandString, 'WriteExpandString');
|
||||||
|
RegisterMethod(@TRegistry.WriteTime, 'WriteTime');
|
||||||
|
RegisterPropertyHelper(@TRegistryCurrentKey_R,nil,'CurrentKey');
|
||||||
|
RegisterPropertyHelper(@TRegistryCurrentPath_R,nil,'CurrentPath');
|
||||||
|
RegisterPropertyHelper(@TRegistryLazyWrite_R,@TRegistryLazyWrite_W,'LazyWrite');
|
||||||
|
RegisterPropertyHelper(@TRegistryRootKey_R,@TRegistryRootKey_W,'RootKey');
|
||||||
|
RegisterPropertyHelper(@TRegistryAccess_R,@TRegistryAccess_W,'Access');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_Registry(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(ERegistryException) do
|
||||||
|
RIRegister_TRegistry(CL);
|
||||||
|
RIRegister_TRegIniFile(CL);
|
||||||
|
RIRegister_TRegistryIniFile(CL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
(* === compile-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TMemIniFile(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCustomIniFile', 'TMemIniFile') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCustomIniFile'),'TMemIniFile') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor Create( const FileName : string)');
|
||||||
|
RegisterMethod('Procedure Clear');
|
||||||
|
RegisterMethod('Procedure GetStrings( List : TStrings)');
|
||||||
|
RegisterMethod('Procedure Rename( const FileName : string; Reload : Boolean)');
|
||||||
|
RegisterMethod('Procedure SetStrings( List : TStrings)');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TIniFile(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TCustomIniFile', 'TIniFile') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TCustomIniFile'),'TIniFile') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Function ReadString( const Section, Ident, Default : string) : string');
|
||||||
|
RegisterMethod('Procedure WriteString( const Section, Ident, Value : String)');
|
||||||
|
RegisterMethod('Procedure ReadSection( const Section : string; Strings : TStrings)');
|
||||||
|
RegisterMethod('Procedure ReadSections( Strings : TStrings)');
|
||||||
|
RegisterMethod('Procedure ReadSectionValues( const Section : string; Strings : TStrings)');
|
||||||
|
RegisterMethod('Procedure EraseSection( const Section : string)');
|
||||||
|
RegisterMethod('Procedure DeleteKey( const Section, Ident : String)');
|
||||||
|
RegisterMethod('Procedure UpdateFile');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_TCustomIniFile(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
//with RegClassS(CL,'TObject', 'TCustomIniFile') do
|
||||||
|
with CL.AddClassN(CL.FindClass('TObject'),'TCustomIniFile') do
|
||||||
|
begin
|
||||||
|
RegisterMethod('Constructor Create( const FileName : string)');
|
||||||
|
RegisterMethod('Function SectionExists( const Section : string) : Boolean');
|
||||||
|
// RegisterMethod('Function ReadString( const Section, Ident, Default : string) : string');
|
||||||
|
// RegisterMethod('Procedure WriteString( const Section, Ident, Value : String)');
|
||||||
|
RegisterMethod('Function ReadInteger( const Section, Ident : string; Default : Longint) : Longint');
|
||||||
|
RegisterMethod('Procedure WriteInteger( const Section, Ident : string; Value : Longint)');
|
||||||
|
RegisterMethod('Function ReadBool( const Section, Ident : string; Default : Boolean) : Boolean');
|
||||||
|
RegisterMethod('Procedure WriteBool( const Section, Ident : string; Value : Boolean)');
|
||||||
|
RegisterMethod('Function ReadDate( const Section, Name : string; Default : TDateTime) : TDateTime');
|
||||||
|
RegisterMethod('Function ReadDateTime( const Section, Name : string; Default : TDateTime) : TDateTime');
|
||||||
|
RegisterMethod('Function ReadFloat( const Section, Name : string; Default : Double) : Double');
|
||||||
|
RegisterMethod('Function ReadTime( const Section, Name : string; Default : TDateTime) : TDateTime');
|
||||||
|
RegisterMethod('Procedure WriteDate( const Section, Name : string; Value : TDateTime)');
|
||||||
|
RegisterMethod('Procedure WriteDateTime( const Section, Name : string; Value : TDateTime)');
|
||||||
|
RegisterMethod('Procedure WriteFloat( const Section, Name : string; Value : Double)');
|
||||||
|
RegisterMethod('Procedure WriteTime( const Section, Name : string; Value : TDateTime)');
|
||||||
|
// RegisterMethod('Procedure ReadSection( const Section : string; Strings : TStrings)');
|
||||||
|
// RegisterMethod('Procedure ReadSections( Strings : TStrings)');
|
||||||
|
// RegisterMethod('Procedure ReadSectionValues( const Section : string; Strings : TStrings)');
|
||||||
|
// RegisterMethod('Procedure EraseSection( const Section : string)');
|
||||||
|
// RegisterMethod('Procedure DeleteKey( const Section, Ident : String)');
|
||||||
|
// RegisterMethod('Procedure UpdateFile');
|
||||||
|
RegisterMethod('Function ValueExists( const Section, Ident : string) : Boolean');
|
||||||
|
RegisterProperty('FileName', 'string', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure SIRegister_IniFiles(CL: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_TCustomIniFile(CL);
|
||||||
|
SIRegister_TIniFile(CL);
|
||||||
|
SIRegister_TMemIniFile(CL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
(* === run-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TCustomIniFileFileName_R(Self: TCustomIniFile; var T: string);
|
||||||
|
begin T := Self.FileName; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TMemIniFile(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TMemIniFile) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TMemIniFile.Create, 'Create');
|
||||||
|
RegisterMethod(@TMemIniFile.Clear, 'Clear');
|
||||||
|
RegisterMethod(@TMemIniFile.GetStrings, 'GetStrings');
|
||||||
|
RegisterMethod(@TMemIniFile.Rename, 'Rename');
|
||||||
|
RegisterMethod(@TMemIniFile.SetStrings, 'SetStrings');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TIniFile(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TIniFile) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TIniFile.ReadString, 'ReadString');
|
||||||
|
RegisterMethod(@TIniFile.WriteString, 'WriteString');
|
||||||
|
RegisterMethod(@TIniFile.ReadSection, 'ReadSection');
|
||||||
|
RegisterMethod(@TIniFile.ReadSections, 'ReadSections');
|
||||||
|
RegisterMethod(@TIniFile.ReadSectionValues, 'ReadSectionValues');
|
||||||
|
RegisterMethod(@TIniFile.EraseSection, 'EraseSection');
|
||||||
|
RegisterMethod(@TIniFile.DeleteKey, 'DeleteKey');
|
||||||
|
RegisterMethod(@TIniFile.UpdateFile, 'UpdateFile');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TCustomIniFile(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TCustomIniFile) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TCustomIniFile.Create, 'Create');
|
||||||
|
RegisterMethod(@TCustomIniFile.SectionExists, 'SectionExists');
|
||||||
|
// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.ReadString, 'ReadString');
|
||||||
|
// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.WriteString, 'WriteString');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.ReadInteger, 'ReadInteger');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.WriteInteger, 'WriteInteger');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.ReadBool, 'ReadBool');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.WriteBool, 'WriteBool');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.ReadDate, 'ReadDate');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.ReadDateTime, 'ReadDateTime');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.ReadFloat, 'ReadFloat');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.ReadTime, 'ReadTime');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.WriteDate, 'WriteDate');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.WriteDateTime, 'WriteDateTime');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.WriteFloat, 'WriteFloat');
|
||||||
|
RegisterVirtualMethod(@TCustomIniFile.WriteTime, 'WriteTime');
|
||||||
|
// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.ReadSection, 'ReadSection');
|
||||||
|
// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.ReadSections, 'ReadSections');
|
||||||
|
// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.ReadSectionValues, 'ReadSectionValues');
|
||||||
|
// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.EraseSection, 'EraseSection');
|
||||||
|
// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.DeleteKey, 'DeleteKey');
|
||||||
|
// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.UpdateFile, 'UpdateFile');
|
||||||
|
RegisterMethod(@TCustomIniFile.ValueExists, 'ValueExists');
|
||||||
|
RegisterPropertyHelper(@TCustomIniFileFileName_R,nil,'FileName');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_IniFiles(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_TCustomIniFile(CL);
|
||||||
|
RIRegister_TIniFile(CL);
|
||||||
|
RIRegister_TMemIniFile(CL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSImport_Registry }
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Registry.CompOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Registry.ExecOnUses(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Registry.CompileImport1(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
SIRegister_Registry(CompExec.Comp);
|
||||||
|
SIRegister_IniFiles(CompExec.Comp);
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Registry.CompileImport2(CompExec: TPSScript);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Registry.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegister_Registry(ri);
|
||||||
|
RIRegister_IniFiles(ri);
|
||||||
|
end;
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TPSImport_Registry.ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
{ nothing }
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
800
Units/PascalScript/uPSPreProcessor.pas
Normal file
800
Units/PascalScript/uPSPreProcessor.pas
Normal file
@ -0,0 +1,800 @@
|
|||||||
|
|
||||||
|
unit uPSPreProcessor;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, uPSCompiler, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
EPSPreProcessor = class(Exception); //- jgv
|
||||||
|
TPSPreProcessor = class;
|
||||||
|
TPSPascalPreProcessorParser = class;
|
||||||
|
|
||||||
|
TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean;
|
||||||
|
TPSOnProcessDirective = procedure (
|
||||||
|
Sender: TPSPreProcessor;
|
||||||
|
Parser: TPSPascalPreProcessorParser;
|
||||||
|
const Active: Boolean;
|
||||||
|
const DirectiveName, DirectiveParam: tbtString;
|
||||||
|
Var Continue: Boolean); //- jgv - application set continue to false to stop the normal directive processing
|
||||||
|
|
||||||
|
TPSLineInfo = class(TObject)
|
||||||
|
private
|
||||||
|
function GetLineOffset(I: Integer): Cardinal;
|
||||||
|
function GetLineOffsetCount: Longint;
|
||||||
|
protected
|
||||||
|
FEndPos: Cardinal;
|
||||||
|
FStartPos: Cardinal;
|
||||||
|
FFileName: tbtstring;
|
||||||
|
FLineOffsets: TIfList;
|
||||||
|
public
|
||||||
|
|
||||||
|
property FileName: tbtstring read FFileName;
|
||||||
|
|
||||||
|
property StartPos: Cardinal read FStartPos;
|
||||||
|
|
||||||
|
property EndPos: Cardinal read FEndPos;
|
||||||
|
|
||||||
|
property LineOffsetCount: Longint read GetLineOffsetCount;
|
||||||
|
|
||||||
|
property LineOffset[I: Longint]: Cardinal read GetLineOffset;
|
||||||
|
|
||||||
|
|
||||||
|
constructor Create;
|
||||||
|
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPSLineInfoResults = record
|
||||||
|
|
||||||
|
Row,
|
||||||
|
Col,
|
||||||
|
Pos: Cardinal;
|
||||||
|
|
||||||
|
Name: tbtstring;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPSLineInfoList = class(TObject)
|
||||||
|
private
|
||||||
|
FItems: TIfList;
|
||||||
|
FCurrent: Longint;
|
||||||
|
function GetCount: Longint;
|
||||||
|
function GetItem(I: Integer): TPSLineInfo;
|
||||||
|
protected
|
||||||
|
|
||||||
|
function Add: TPSLineInfo;
|
||||||
|
public
|
||||||
|
|
||||||
|
property Count: Longint read GetCount;
|
||||||
|
|
||||||
|
property Items[I: Longint]: TPSLineInfo read GetItem; default;
|
||||||
|
|
||||||
|
procedure Clear;
|
||||||
|
|
||||||
|
function GetLineInfo(const ModuleName: tbtstring; Pos: Cardinal; var Res: TPSLineInfoResults): Boolean;
|
||||||
|
|
||||||
|
property Current: Longint read FCurrent write FCurrent;
|
||||||
|
|
||||||
|
|
||||||
|
constructor Create;
|
||||||
|
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
TPSDefineStates = class;
|
||||||
|
|
||||||
|
TPSPreProcessor = class(TObject)
|
||||||
|
private
|
||||||
|
FID: Pointer;
|
||||||
|
FCurrentDefines, FDefines: TStringList;
|
||||||
|
FCurrentLineInfo: TPSLineInfoList;
|
||||||
|
FOnNeedFile: TPSOnNeedFile;
|
||||||
|
FAddedPosition: Cardinal;
|
||||||
|
FDefineState: TPSDefineStates;
|
||||||
|
FMaxLevel: Longint;
|
||||||
|
FMainFileName: tbtstring;
|
||||||
|
FMainFile: tbtstring;
|
||||||
|
FOnProcessDirective: TPSOnProcessDirective;
|
||||||
|
FOnProcessUnknowDirective: TPSOnProcessDirective;
|
||||||
|
procedure ParserNewLine(Sender: TPSPascalPreProcessorParser; Row, Col, Pos: Cardinal);
|
||||||
|
procedure IntPreProcess(Level: Integer; const OrgFileName: tbtstring; FileName: tbtstring; Dest: TStream);
|
||||||
|
protected
|
||||||
|
procedure doAddStdPredefines; virtual; // jgv
|
||||||
|
public
|
||||||
|
{The maximum number of levels deep the parser will go, defaults to 20}
|
||||||
|
property MaxLevel: Longint read FMaxLevel write FMaxLevel;
|
||||||
|
property CurrentLineInfo: TPSLineInfoList read FCurrentLineInfo;
|
||||||
|
|
||||||
|
property OnNeedFile: TPSOnNeedFile read FOnNeedFile write FOnNeedFile;
|
||||||
|
|
||||||
|
property Defines: TStringList read FDefines write FDefines;
|
||||||
|
|
||||||
|
property MainFile: tbtstring read FMainFile write FMainFile;
|
||||||
|
|
||||||
|
property MainFileName: tbtstring read FMainFileName write FMainFileName;
|
||||||
|
|
||||||
|
property ID: Pointer read FID write FID;
|
||||||
|
|
||||||
|
procedure AdjustMessages(Comp: TPSPascalCompiler);
|
||||||
|
procedure AdjustMessage(Msg: TPSPascalCompilerMessage); //-jgv
|
||||||
|
|
||||||
|
procedure PreProcess(const Filename: tbtstring; var Output: tbtstring);
|
||||||
|
|
||||||
|
procedure Clear;
|
||||||
|
|
||||||
|
|
||||||
|
constructor Create;
|
||||||
|
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
property OnProcessDirective: TPSOnProcessDirective read fOnProcessDirective write fOnProcessDirective;
|
||||||
|
property OnProcessUnknowDirective: TPSOnProcessDirective read fOnProcessUnknowDirective write fOnProcessUnknowDirective;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPSPascalPreProcessorType = (ptEOF, ptOther, ptDefine);
|
||||||
|
|
||||||
|
TPSOnNewLine = procedure (Sender: TPSPascalPreProcessorParser; Row, Col, Pos: Cardinal) of object;
|
||||||
|
|
||||||
|
TPSPascalPreProcessorParser = class(TObject)
|
||||||
|
private
|
||||||
|
FData: tbtstring;
|
||||||
|
FText: PAnsichar;
|
||||||
|
FToken: tbtstring;
|
||||||
|
FTokenId: TPSPascalPreProcessorType;
|
||||||
|
FLastEnterPos, FLen, FRow, FCol, FPos: Cardinal;
|
||||||
|
FOnNewLine: TPSOnNewLine;
|
||||||
|
public
|
||||||
|
|
||||||
|
procedure SetText(const dta: tbtstring);
|
||||||
|
|
||||||
|
procedure Next;
|
||||||
|
|
||||||
|
property Token: tbtstring read FToken;
|
||||||
|
|
||||||
|
property TokenId: TPSPascalPreProcessorType read FTokenId;
|
||||||
|
|
||||||
|
property Row: Cardinal read FRow;
|
||||||
|
|
||||||
|
property Col: Cardinal read FCol;
|
||||||
|
|
||||||
|
property Pos: Cardinal read FPos;
|
||||||
|
|
||||||
|
property OnNewLine: TPSOnNewLine read FOnNewLine write FOnNewLine;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPSDefineState = class(TObject)
|
||||||
|
private
|
||||||
|
FInElse: Boolean;
|
||||||
|
FDoWrite: Boolean;
|
||||||
|
public
|
||||||
|
|
||||||
|
property InElse: Boolean read FInElse write FInElse;
|
||||||
|
|
||||||
|
property DoWrite: Boolean read FDoWrite write FDoWrite;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPSDefineStates = class(TObject)
|
||||||
|
private
|
||||||
|
FItems: TIfList;
|
||||||
|
function GetCount: Longint;
|
||||||
|
function GetItem(I: Integer): TPSDefineState;
|
||||||
|
function GetWrite: Boolean;
|
||||||
|
function GetPrevWrite: Boolean; //JeromeWelsh - nesting fix
|
||||||
|
public
|
||||||
|
|
||||||
|
property Count: Longint read GetCount;
|
||||||
|
|
||||||
|
property Item[I: Longint]: TPSDefineState read GetItem; default;
|
||||||
|
|
||||||
|
function Add: TPSDefineState;
|
||||||
|
|
||||||
|
procedure Delete(I: Longint);
|
||||||
|
|
||||||
|
|
||||||
|
constructor Create;
|
||||||
|
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure Clear;
|
||||||
|
|
||||||
|
property DoWrite: Boolean read GetWrite;
|
||||||
|
property DoPrevWrite: Boolean read GetPrevWrite; //JeromeWelsh - nesting fix
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP }
|
||||||
|
resourceString
|
||||||
|
{$ELSE }
|
||||||
|
const
|
||||||
|
{$ENDIF }
|
||||||
|
|
||||||
|
RPS_TooManyNestedInclude = 'Too many nested include files while processing ''%s'' from ''%s''';
|
||||||
|
RPS_IncludeNotFound = 'Unable to find file ''%s'' used from ''%s''';
|
||||||
|
RPS_DefineTooManyParameters = 'Too many parameters at %d:%d';
|
||||||
|
RPS_NoIfdefForEndif = 'No IFDEF for ENDIF at %d:%d';
|
||||||
|
RPS_NoIfdefForElse = 'No IFDEF for ELSE at %d:%d';
|
||||||
|
RPS_ElseTwice = 'Can''t use ELSE twice at %d:%d';
|
||||||
|
RPS_UnknownCompilerDirective = 'Unknown compiler directives at %d:%d';
|
||||||
|
RPs_DefineNotClosed = 'Define not closed';
|
||||||
|
|
||||||
|
{ TPSLineInfoList }
|
||||||
|
|
||||||
|
function TPSLineInfoList.Add: TPSLineInfo;
|
||||||
|
begin
|
||||||
|
Result := TPSLineInfo.Create;
|
||||||
|
FItems.Add(Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSLineInfoList.Clear;
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
begin
|
||||||
|
for i := FItems.count -1 downto 0 do
|
||||||
|
TPSLineInfo(FItems[i]).Free;
|
||||||
|
FItems.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPSLineInfoList.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FItems := TIfList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TPSLineInfoList.Destroy;
|
||||||
|
begin
|
||||||
|
Clear;
|
||||||
|
FItems.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSLineInfoList.GetCount: Longint;
|
||||||
|
begin
|
||||||
|
Result := FItems.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSLineInfoList.GetItem(I: Integer): TPSLineInfo;
|
||||||
|
begin
|
||||||
|
Result := TPSLineInfo(FItems[i]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSLineInfoList.GetLineInfo(const ModuleName: tbtstring; Pos: Cardinal; var Res: TPSLineInfoResults): Boolean;
|
||||||
|
var
|
||||||
|
i,j: Longint;
|
||||||
|
linepos: Cardinal;
|
||||||
|
Item: TPSLineInfo;
|
||||||
|
lModuleName: tbtstring;
|
||||||
|
begin
|
||||||
|
lModuleName := FastUpperCase(ModuleName);
|
||||||
|
|
||||||
|
for i := FItems.Count -1 downto 0 do
|
||||||
|
begin
|
||||||
|
Item := FItems[i];
|
||||||
|
if (Pos >= Item.StartPos) and (Pos < Item.EndPos) and
|
||||||
|
(lModuleName = '') or (lModuleName = Item.FileName) then
|
||||||
|
begin
|
||||||
|
Res.Name := Item.FileName;
|
||||||
|
Pos := Pos - Item.StartPos;
|
||||||
|
Res.Pos := Pos;
|
||||||
|
Res.Col := 1;
|
||||||
|
Res.Row := 1;
|
||||||
|
LinePos := 0;
|
||||||
|
for j := 0 to Item.LineOffsetCount -1 do
|
||||||
|
begin
|
||||||
|
if Pos >= Item.LineOffset[j] then
|
||||||
|
begin
|
||||||
|
linepos := Item.LineOffset[j];
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
Res.Row := j; // j -1, but line counting starts at 1
|
||||||
|
Res.Col := pos - linepos + 1;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSLineInfo }
|
||||||
|
|
||||||
|
constructor TPSLineInfo.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FLineOffsets := TIfList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TPSLineInfo.Destroy;
|
||||||
|
begin
|
||||||
|
FLineOffsets.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TPSLineInfo.GetLineOffset(I: Integer): Cardinal;
|
||||||
|
begin
|
||||||
|
Result := Longint(FLineOffsets[I]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSLineInfo.GetLineOffsetCount: Longint;
|
||||||
|
begin
|
||||||
|
result := FLineOffsets.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSPascalPreProcessorParser }
|
||||||
|
|
||||||
|
procedure TPSPascalPreProcessorParser.Next;
|
||||||
|
var
|
||||||
|
ci: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FPos := FPos + FLen;
|
||||||
|
case FText[FPos] of
|
||||||
|
#0:
|
||||||
|
begin
|
||||||
|
FLen := 0;
|
||||||
|
FTokenId := ptEof;
|
||||||
|
end;
|
||||||
|
'''':
|
||||||
|
begin
|
||||||
|
ci := FPos;
|
||||||
|
while (FText[ci] <> #0) do
|
||||||
|
begin
|
||||||
|
Inc(ci);
|
||||||
|
while FText[ci] = '''' do
|
||||||
|
begin
|
||||||
|
if FText[ci+1] <> '''' then Break;
|
||||||
|
inc(ci);
|
||||||
|
inc(ci);
|
||||||
|
end;
|
||||||
|
if FText[ci] = '''' then Break;
|
||||||
|
if FText[ci] = #13 then
|
||||||
|
begin
|
||||||
|
inc(FRow);
|
||||||
|
if FText[ci] = #10 then
|
||||||
|
inc(ci);
|
||||||
|
FLastEnterPos := ci -1;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1);
|
||||||
|
end else if FText[ci] = #10 then
|
||||||
|
begin
|
||||||
|
inc(FRow);
|
||||||
|
FLastEnterPos := ci -1;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
FLen := ci - FPos + 1;
|
||||||
|
FTokenId := ptOther;
|
||||||
|
end;
|
||||||
|
'(':
|
||||||
|
begin
|
||||||
|
if FText[FPos + 1] = '*' then
|
||||||
|
begin
|
||||||
|
ci := FPos + 1;
|
||||||
|
while (FText[ci] <> #0) do begin
|
||||||
|
if (FText[ci] = '*') and (FText[ci + 1] = ')') then
|
||||||
|
Break;
|
||||||
|
if FText[ci] = #13 then
|
||||||
|
begin
|
||||||
|
inc(FRow);
|
||||||
|
if FText[ci+1] = #10 then
|
||||||
|
inc(ci);
|
||||||
|
FLastEnterPos := ci -1;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1);
|
||||||
|
end else if FText[ci] = #10 then
|
||||||
|
begin
|
||||||
|
inc(FRow);
|
||||||
|
FLastEnterPos := ci -1;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1);
|
||||||
|
end;
|
||||||
|
Inc(ci);
|
||||||
|
end;
|
||||||
|
FTokenId := ptOther;
|
||||||
|
if (FText[ci] <> #0) then
|
||||||
|
Inc(ci, 2);
|
||||||
|
FLen := ci - FPos;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FTokenId := ptOther;
|
||||||
|
FLen := 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
'/':
|
||||||
|
begin
|
||||||
|
if FText[FPos + 1] = '/' then
|
||||||
|
begin
|
||||||
|
ci := FPos + 1;
|
||||||
|
while (FText[ci] <> #0) and (FText[ci] <> #13) and
|
||||||
|
(FText[ci] <> #10) do begin
|
||||||
|
Inc(ci);
|
||||||
|
end;
|
||||||
|
FTokenId := ptOther;
|
||||||
|
FLen := ci - FPos;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
FTokenId := ptOther;
|
||||||
|
FLen := 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
'{':
|
||||||
|
begin
|
||||||
|
ci := FPos + 1;
|
||||||
|
while (FText[ci] <> #0) and (FText[ci] <> '}') do begin
|
||||||
|
if FText[ci] = #13 then
|
||||||
|
begin
|
||||||
|
inc(FRow);
|
||||||
|
if FText[ci+1] = #10 then
|
||||||
|
inc(ci);
|
||||||
|
FLastEnterPos := ci - 1;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1);
|
||||||
|
end else if FText[ci] = #10 then
|
||||||
|
begin
|
||||||
|
inc(FRow);
|
||||||
|
FLastEnterPos := ci - 1;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1);
|
||||||
|
end;
|
||||||
|
Inc(ci);
|
||||||
|
end;
|
||||||
|
if (FText[FPos + 1] = '$') or (FText[FPos + 1] = '.') then
|
||||||
|
FTokenId := ptDefine
|
||||||
|
else
|
||||||
|
FTokenId := ptOther;
|
||||||
|
|
||||||
|
FLen := ci - FPos + 1;
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ci := FPos + 1;
|
||||||
|
while not (FText[ci] in [#0,'{', '(', '''', '/']) do
|
||||||
|
begin
|
||||||
|
if FText[ci] = #13 then
|
||||||
|
begin
|
||||||
|
inc(FRow);
|
||||||
|
if FText[ci+1] = #10 then
|
||||||
|
inc(ci);
|
||||||
|
FLastEnterPos := ci - 1;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1);
|
||||||
|
end else if FText[ci] = #10 then
|
||||||
|
begin
|
||||||
|
inc(FRow);
|
||||||
|
FLastEnterPos := ci -1 ;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1);
|
||||||
|
end;
|
||||||
|
Inc(Ci);
|
||||||
|
end;
|
||||||
|
FTokenId := ptOther;
|
||||||
|
FLen := ci - FPos;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
FCol := FPos - FLastEnterPos + 1;
|
||||||
|
FToken := Copy(FData, FPos +1, FLen);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSPascalPreProcessorParser.SetText(const dta: tbtstring);
|
||||||
|
begin
|
||||||
|
FData := dta;
|
||||||
|
FText := pAnsichar(FData);
|
||||||
|
FLen := 0;
|
||||||
|
FPos := 0;
|
||||||
|
FCol := 1;
|
||||||
|
FLastEnterPos := 0;
|
||||||
|
FRow := 1;
|
||||||
|
if @FOnNewLine <> nil then FOnNewLine(Self, 1, 1, 0);
|
||||||
|
Next;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSPreProcessor }
|
||||||
|
|
||||||
|
procedure TPSPreProcessor.AdjustMessage(Msg: TPSPascalCompilerMessage);
|
||||||
|
var
|
||||||
|
Res: TPSLineInfoResults;
|
||||||
|
begin
|
||||||
|
if CurrentLineInfo.GetLineInfo(Msg.ModuleName, Msg.Pos, Res) then
|
||||||
|
begin
|
||||||
|
Msg.SetCustomPos(res.Pos, Res.Row, Res.Col);
|
||||||
|
Msg.ModuleName := Res.Name;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSPreProcessor.AdjustMessages(Comp: TPSPascalCompiler);
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
begin
|
||||||
|
for i := 0 to Comp.MsgCount -1 do
|
||||||
|
AdjustMessage (Comp.Msg[i]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSPreProcessor.Clear;
|
||||||
|
begin
|
||||||
|
FDefineState.Clear;
|
||||||
|
FDefines.Clear;
|
||||||
|
FCurrentDefines.Clear;
|
||||||
|
FCurrentLineInfo.Clear;
|
||||||
|
FMainFile := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPSPreProcessor.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FDefines := TStringList.Create;
|
||||||
|
FCurrentLineInfo := TPSLineInfoList.Create;
|
||||||
|
FCurrentDefines := TStringList.Create;
|
||||||
|
FDefines.Duplicates := dupIgnore;
|
||||||
|
FCurrentDefines.Duplicates := dupIgnore;
|
||||||
|
FDefineState := TPSDefineStates.Create;
|
||||||
|
FMaxLevel := 20;
|
||||||
|
|
||||||
|
doAddStdPredefines;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TPSPreProcessor.Destroy;
|
||||||
|
begin
|
||||||
|
FDefineState.Free;
|
||||||
|
FCurrentDefines.Free;
|
||||||
|
FDefines.Free;
|
||||||
|
FCurrentLineInfo.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSPreProcessor.doAddStdPredefines;
|
||||||
|
begin
|
||||||
|
//--- 20050708_jgv
|
||||||
|
FCurrentDefines.Add (Format ('VER%d', [PSCurrentBuildNo]));
|
||||||
|
{$IFDEF CPU386 }
|
||||||
|
FCurrentDefines.Add ('CPU386');
|
||||||
|
{$ENDIF }
|
||||||
|
{$IFDEF MSWINDOWS }
|
||||||
|
FCurrentDefines.Add ('MSWINDOWS');
|
||||||
|
FCurrentDefines.Add ('WIN32');
|
||||||
|
{$ENDIF }
|
||||||
|
{$IFDEF LINUX }
|
||||||
|
FCurrentDefines.Add ('LINUX');
|
||||||
|
{$ENDIF }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName: tbtstring; FileName: tbtstring; Dest: TStream);
|
||||||
|
var
|
||||||
|
Parser: TPSPascalPreProcessorParser;
|
||||||
|
dta: tbtstring;
|
||||||
|
item: TPSLineInfo;
|
||||||
|
s, name: tbtstring;
|
||||||
|
current, i: Longint;
|
||||||
|
ds: TPSDefineState;
|
||||||
|
AppContinue: Boolean;
|
||||||
|
begin
|
||||||
|
if Level > MaxLevel then raise EPSPreProcessor.CreateFmt(RPS_TooManyNestedInclude, [FileName, OrgFileName]);
|
||||||
|
Parser := TPSPascalPreProcessorParser.Create;
|
||||||
|
try
|
||||||
|
Parser.OnNewLine := ParserNewLine;
|
||||||
|
if FileName = MainFileName then
|
||||||
|
begin
|
||||||
|
dta := MainFile;
|
||||||
|
end else
|
||||||
|
if (@OnNeedFile = nil) or (not OnNeedFile(Self, OrgFileName, FileName, dta)) then
|
||||||
|
raise EPSPreProcessor.CreateFmt(RPS_IncludeNotFound, [FileName, OrgFileName]);
|
||||||
|
Item := FCurrentLineInfo.Add;
|
||||||
|
current := FCurrentLineInfo.Count -1;
|
||||||
|
FCurrentLineInfo.Current := current;
|
||||||
|
Item.FStartPos := Dest.Position;
|
||||||
|
Item.FFileName := FileName;
|
||||||
|
Parser.SetText(dta);
|
||||||
|
while Parser.TokenId <> ptEOF do
|
||||||
|
begin
|
||||||
|
s := Parser.Token;
|
||||||
|
if Parser.TokenId = ptDefine then
|
||||||
|
begin
|
||||||
|
Delete(s,1,2); // delete the {$
|
||||||
|
Delete(s,length(s), 1); // delete the }
|
||||||
|
|
||||||
|
//-- 20050707_jgv trim right
|
||||||
|
i := length (s);
|
||||||
|
while (i > 0) and (s[i] = ' ') do begin
|
||||||
|
Delete (s, i, 1);
|
||||||
|
Dec (i);
|
||||||
|
end;
|
||||||
|
//-- end_jgv
|
||||||
|
|
||||||
|
if pos(tbtChar(' '), s) = 0 then
|
||||||
|
begin
|
||||||
|
name := uppercase(s);
|
||||||
|
s := '';
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
Name := uppercase(copy(s,1,pos(' ', s)-1));
|
||||||
|
Delete(s, 1, pos(' ', s));
|
||||||
|
end;
|
||||||
|
|
||||||
|
//-- 20050707_jgv - ask the application
|
||||||
|
AppContinue := True;
|
||||||
|
If @OnProcessDirective <> Nil then OnProcessDirective (Self, Parser, FDefineState.DoWrite, name, s, AppContinue);
|
||||||
|
|
||||||
|
If AppContinue then
|
||||||
|
//-- end jgv
|
||||||
|
|
||||||
|
if (Name = 'I') or (Name = 'INCLUDE') or (Name = '.INCLUDE') then
|
||||||
|
begin
|
||||||
|
if FDefineState.DoWrite then
|
||||||
|
begin
|
||||||
|
FAddedPosition := 0;
|
||||||
|
IntPreProcess(Level +1, FileName, s, Dest);
|
||||||
|
FCurrentLineInfo.Current := current;
|
||||||
|
FAddedPosition := Cardinal(Dest.Position) - Item.StartPos - Parser.Pos;
|
||||||
|
end;
|
||||||
|
end else if (Name = 'DEFINE') then
|
||||||
|
begin
|
||||||
|
if FDefineState.DoWrite then
|
||||||
|
begin
|
||||||
|
if pos(' ', s) <> 0 then raise EPSPreProcessor.CreateFmt(RPS_DefineTooManyParameters, [Parser.Row, Parser.Col]);
|
||||||
|
FCurrentDefines.Add(Uppercase(S));
|
||||||
|
end;
|
||||||
|
end else if (Name = 'UNDEF') then
|
||||||
|
begin
|
||||||
|
if FDefineState.DoWrite then
|
||||||
|
begin
|
||||||
|
if pos(' ', s) <> 0 then raise EPSPreProcessor.CreateFmt(RPS_DefineTooManyParameters, [Parser.Row, Parser.Col]);
|
||||||
|
i := FCurrentDefines.IndexOf(Uppercase(s));
|
||||||
|
if i <> -1 then
|
||||||
|
FCurrentDefines.Delete(i);
|
||||||
|
end;
|
||||||
|
end else if (Name = 'IFDEF') then
|
||||||
|
begin
|
||||||
|
if pos(' ', s) <> 0 then raise EPSPreProcessor.CreateFmt(RPS_DefineTooManyParameters, [Parser.Row, Parser.Col]);
|
||||||
|
//JeromeWelsh - nesting fix
|
||||||
|
if (FDefineState.DoWrite and (FCurrentDefines.IndexOf(Uppercase(s)) <> -1)) then
|
||||||
|
FDefineState.Add.DoWrite := True
|
||||||
|
else
|
||||||
|
FDefineState.Add.DoWrite := False;
|
||||||
|
end else if (Name = 'IFNDEF') then
|
||||||
|
begin
|
||||||
|
if pos(' ', s) <> 0 then raise EPSPreProcessor.CreateFmt(RPS_DefineTooManyParameters, [Parser.Row, Parser.Col]);
|
||||||
|
//JeromeWelsh - nesting fix
|
||||||
|
if (FCurrentDefines.IndexOf(Uppercase(s)) = -1) and FDefineState.DoWrite then
|
||||||
|
FDefineState.Add.DoWrite := True
|
||||||
|
else
|
||||||
|
FDefineState.Add.DoWrite := False;
|
||||||
|
end else if (Name = 'ENDIF') then
|
||||||
|
begin
|
||||||
|
//- jgv remove - borland use it (sysutils.pas)
|
||||||
|
//- if s <> '' then raise EPSPreProcessor.CreateFmt(RPS_DefineTooManyParameters, [Parser.Row, Parser.Col]);
|
||||||
|
if FDefineState.Count = 0 then
|
||||||
|
raise EPSPreProcessor.CreateFmt(RPS_NoIfdefForEndif, [Parser.Row, Parser.Col]);
|
||||||
|
FDefineState.Delete(FDefineState.Count -1); // remove define from list
|
||||||
|
end else if (Name = 'ELSE') then
|
||||||
|
begin
|
||||||
|
if s<> '' then raise EPSPreProcessor.CreateFmt(RPS_DefineTooManyParameters, [Parser.Row, Parser.Col]);
|
||||||
|
if FDefineState.Count = 0 then
|
||||||
|
raise EPSPreProcessor.CreateFmt(RPS_NoIfdefForElse, [Parser.Row, Parser.Col]);
|
||||||
|
ds := FDefineState[FDefineState.Count -1];
|
||||||
|
if ds.InElse then
|
||||||
|
raise EPSPreProcessor.CreateFmt(RPS_ElseTwice, [Parser.Row, Parser.Col]);
|
||||||
|
ds.FInElse := True;
|
||||||
|
//JeromeWelsh - nesting fix
|
||||||
|
ds.DoWrite := not ds.DoWrite and FDefineState.DoPrevWrite;
|
||||||
|
end
|
||||||
|
|
||||||
|
//-- 20050710_jgv custom application error process
|
||||||
|
else if Parser.Token[2] <> '.' then begin
|
||||||
|
If @OnProcessUnknowDirective <> Nil then begin
|
||||||
|
OnProcessUnknowDirective (Self, Parser, FDefineState.DoWrite, name, s, AppContinue);
|
||||||
|
end;
|
||||||
|
If AppContinue then
|
||||||
|
//-- end jgv
|
||||||
|
|
||||||
|
raise EPSPreProcessor.CreateFmt(RPS_UnknownCompilerDirective, [Parser.Row, Parser.Col]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (not FDefineState.DoWrite) or (Parser.TokenId = ptDefine) then
|
||||||
|
begin
|
||||||
|
SetLength(s, Length(Parser.Token));
|
||||||
|
for i := length(s) downto 1 do
|
||||||
|
s[i] := #32; // space
|
||||||
|
end;
|
||||||
|
Dest.Write(s[1], length(s));
|
||||||
|
Parser.Next;
|
||||||
|
end;
|
||||||
|
Item.FEndPos := Dest.Position;
|
||||||
|
finally
|
||||||
|
Parser.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSPreProcessor.ParserNewLine(Sender: TPSPascalPreProcessorParser; Row, Col, Pos: Cardinal);
|
||||||
|
begin
|
||||||
|
if FCurrentLineInfo.Current >= FCurrentLineInfo.Count then exit; //errr ???
|
||||||
|
with FCurrentLineInfo.Items[FCurrentLineInfo.Current] do
|
||||||
|
begin
|
||||||
|
Pos := Pos + FAddedPosition;
|
||||||
|
FLineOffsets.Add(Pointer(Pos));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSPreProcessor.PreProcess(const Filename: tbtstring; var Output: tbtstring);
|
||||||
|
var
|
||||||
|
Stream: TMemoryStream;
|
||||||
|
begin
|
||||||
|
FAddedPosition := 0;
|
||||||
|
FCurrentDefines.Assign(FDefines);
|
||||||
|
Stream := TMemoryStream.Create;
|
||||||
|
try
|
||||||
|
IntPreProcess(0, '', FileName, Stream);
|
||||||
|
Stream.Position := 0;
|
||||||
|
SetLength(Output, Stream.Size);
|
||||||
|
Stream.Read(Output[1], Length(Output));
|
||||||
|
finally
|
||||||
|
Stream.Free;
|
||||||
|
end;
|
||||||
|
if FDefineState.Count <> 0 then
|
||||||
|
raise EPSPreProcessor.Create(RPs_DefineNotClosed);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSDefineStates }
|
||||||
|
|
||||||
|
function TPSDefineStates.Add: TPSDefineState;
|
||||||
|
begin
|
||||||
|
Result := TPSDefineState.Create;
|
||||||
|
FItems.Add(Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSDefineStates.Clear;
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
begin
|
||||||
|
for i := Longint(FItems.Count) -1 downto 0 do
|
||||||
|
TPSDefineState(FItems[i]).Free;
|
||||||
|
FItems.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPSDefineStates.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FItems := TIfList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPSDefineStates.Delete(I: Integer);
|
||||||
|
begin
|
||||||
|
TPSDefineState(FItems[i]).Free;
|
||||||
|
FItems.Delete(i);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TPSDefineStates.Destroy;
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
begin
|
||||||
|
for i := Longint(FItems.Count) -1 downto 0 do
|
||||||
|
TPSDefineState(FItems[i]).Free;
|
||||||
|
FItems.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSDefineStates.GetCount: Longint;
|
||||||
|
begin
|
||||||
|
Result := FItems.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSDefineStates.GetItem(I: Integer): TPSDefineState;
|
||||||
|
begin
|
||||||
|
Result := FItems[i];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPSDefineStates.GetWrite: Boolean;
|
||||||
|
begin
|
||||||
|
if FItems.Count = 0 then
|
||||||
|
result := true
|
||||||
|
else Result := TPSDefineState(FItems[FItems.Count -1]).DoWrite;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//JeromeWelsh - nesting fix
|
||||||
|
function TPSDefineStates.GetPrevWrite: Boolean;
|
||||||
|
begin
|
||||||
|
if FItems.Count < 2 then
|
||||||
|
result := true
|
||||||
|
else Result := TPSDefineState(FItems[FItems.Count -2]).DoWrite;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
2094
Units/PascalScript/uPSR_DB.pas
Normal file
2094
Units/PascalScript/uPSR_DB.pas
Normal file
File diff suppressed because it is too large
Load Diff
38
Units/PascalScript/uPSR_buttons.pas
Normal file
38
Units/PascalScript/uPSR_buttons.pas
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
|
||||||
|
unit uPSR_buttons;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTSPEEDBUTTON(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTBITBTN(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
procedure RIRegister_Buttons(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
Classes{$IFDEF CLX}, QControls, QButtons{$ELSE}, Controls, Buttons{$ENDIF};
|
||||||
|
|
||||||
|
procedure RIRegisterTSPEEDBUTTON(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TSPEEDBUTTON);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTBITBTN(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TBITBTN);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegister_Buttons(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegisterTSPEEDBUTTON(cl);
|
||||||
|
RIRegisterTBITBTN(cl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
383
Units/PascalScript/uPSR_classes.pas
Normal file
383
Units/PascalScript/uPSR_classes.pas
Normal file
@ -0,0 +1,383 @@
|
|||||||
|
|
||||||
|
unit uPSR_classes;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTStrings(cl: TPSRuntimeClassImporter; Streams: Boolean);
|
||||||
|
procedure RIRegisterTStringList(cl: TPSRuntimeClassImporter);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure RIRegisterTBITS(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$ENDIF}
|
||||||
|
procedure RIRegisterTSTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTHANDLESTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTFILESTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure RIRegisterTCUSTOMMEMORYSTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTMEMORYSTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTRESOURCESTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTPARSER(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure RIRegisterTOWNEDCOLLECTION(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$ENDIF}
|
||||||
|
procedure RIRegisterTCOLLECTION(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCOLLECTIONITEM(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegister_Classes(Cl: TPSRuntimeClassImporter; Streams: Boolean{$IFDEF D4PLUS}=True{$ENDIF});
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
Classes;
|
||||||
|
|
||||||
|
procedure TStringsCountR(Self: TStrings; var T: Longint); begin T := Self.Count; end;
|
||||||
|
|
||||||
|
procedure TStringsTextR(Self: TStrings; var T: string); begin T := Self.Text; end;
|
||||||
|
procedure TStringsTextW(Self: TStrings; T: string); begin Self.Text:= T; end;
|
||||||
|
|
||||||
|
procedure TStringsCommaTextR(Self: TStrings; var T: string); begin T := Self.CommaText; end;
|
||||||
|
procedure TStringsCommaTextW(Self: TStrings; T: string); begin Self.CommaText:= T; end;
|
||||||
|
|
||||||
|
procedure TStringsObjectsR(Self: TStrings; var T: TObject; I: Longint);
|
||||||
|
begin
|
||||||
|
T := Self.Objects[I];
|
||||||
|
end;
|
||||||
|
procedure TStringsObjectsW(Self: TStrings; const T: TObject; I: Longint);
|
||||||
|
begin
|
||||||
|
Self.Objects[I]:= T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TStringsStringsR(Self: TStrings; var T: string; I: Longint);
|
||||||
|
begin
|
||||||
|
T := Self.Strings[I];
|
||||||
|
end;
|
||||||
|
procedure TStringsStringsW(Self: TStrings; const T: string; I: Longint);
|
||||||
|
begin
|
||||||
|
Self.Strings[I]:= T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TStringsNamesR(Self: TStrings; var T: string; I: Longint);
|
||||||
|
begin
|
||||||
|
T := Self.Names[I];
|
||||||
|
end;
|
||||||
|
procedure TStringsValuesR(Self: TStrings; var T: string; const I: string);
|
||||||
|
begin
|
||||||
|
T := Self.Values[I];
|
||||||
|
end;
|
||||||
|
procedure TStringsValuesW(Self: TStrings; Const T, I: String);
|
||||||
|
begin
|
||||||
|
Self.Values[I]:= T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTStrings(cl: TPSRuntimeClassImporter; Streams: Boolean); // requires TPersistent
|
||||||
|
begin
|
||||||
|
with Cl.Add(TStrings) do
|
||||||
|
begin
|
||||||
|
RegisterVirtualMethod(@TStrings.Add, 'ADD');
|
||||||
|
RegisterMethod(@TStrings.Append, 'APPEND');
|
||||||
|
RegisterVirtualMethod(@TStrings.AddStrings, 'ADDSTRINGS');
|
||||||
|
RegisterVirtualAbstractMethod(TStringList, @TStringList.Clear, 'CLEAR');
|
||||||
|
RegisterVirtualAbstractMethod(TStringList, @TStringList.Delete, 'DELETE');
|
||||||
|
RegisterVirtualMethod(@TStrings.IndexOf, 'INDEXOF');
|
||||||
|
RegisterVirtualAbstractMethod(TStringList, @TStringList.Insert, 'INSERT');
|
||||||
|
RegisterPropertyHelper(@TStringsCountR, nil, 'COUNT');
|
||||||
|
RegisterPropertyHelper(@TStringsTextR, @TStringsTextW, 'TEXT');
|
||||||
|
RegisterPropertyHelper(@TStringsCommaTextR, @TStringsCommatextW, 'COMMATEXT');
|
||||||
|
if Streams then
|
||||||
|
begin
|
||||||
|
RegisterVirtualMethod(@TStrings.LoadFromFile, 'LOADFROMFILE');
|
||||||
|
RegisterVirtualMethod(@TStrings.SaveToFile, 'SAVETOFILE');
|
||||||
|
end;
|
||||||
|
RegisterPropertyHelper(@TStringsStringsR, @TStringsStringsW, 'STRINGS');
|
||||||
|
RegisterPropertyHelper(@TStringsObjectsR, @TStringsObjectsW, 'OBJECTS');
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod(@TStrings.BeginUpdate, 'BEGINUPDATE');
|
||||||
|
RegisterMethod(@TStrings.EndUpdate, 'ENDUPDATE');
|
||||||
|
RegisterMethod(@TStrings.Equals, 'EQUALS');
|
||||||
|
RegisterVirtualMethod(@TStrings.Exchange, 'EXCHANGE');
|
||||||
|
RegisterMethod(@TStrings.IndexOfName, 'INDEXOFNAME');
|
||||||
|
if Streams then
|
||||||
|
RegisterVirtualMethod(@TStrings.LoadFromStream, 'LOADFROMSTREAM');
|
||||||
|
RegisterVirtualMethod(@TStrings.Move, 'MOVE');
|
||||||
|
if Streams then
|
||||||
|
RegisterVirtualMethod(@TStrings.SaveToStream, 'SAVETOSTREAM');
|
||||||
|
RegisterVirtualMethod(@TStrings.SetText, 'SETTEXT');
|
||||||
|
RegisterPropertyHelper(@TStringsNamesR, nil, 'NAMES');
|
||||||
|
RegisterPropertyHelper(@TStringsValuesR, @TStringsValuesW, 'VALUES');
|
||||||
|
RegisterVirtualMethod(@TSTRINGS.ADDOBJECT, 'ADDOBJECT');
|
||||||
|
RegisterVirtualMethod(@TSTRINGS.GETTEXT, 'GETTEXT');
|
||||||
|
RegisterMethod(@TSTRINGS.INDEXOFOBJECT, 'INDEXOFOBJECT');
|
||||||
|
RegisterMethod(@TSTRINGS.INSERTOBJECT, 'INSERTOBJECT');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSTRINGLISTDUPLICATES_R(Self: TSTRINGLIST; var T: TDUPLICATES); begin T := Self.DUPLICATES; end;
|
||||||
|
procedure TSTRINGLISTDUPLICATES_W(Self: TSTRINGLIST; const T: TDUPLICATES); begin Self.DUPLICATES := T; end;
|
||||||
|
procedure TSTRINGLISTSORTED_R(Self: TSTRINGLIST; var T: BOOLEAN); begin T := Self.SORTED; end;
|
||||||
|
procedure TSTRINGLISTSORTED_W(Self: TSTRINGLIST; const T: BOOLEAN); begin Self.SORTED := T; end;
|
||||||
|
procedure TSTRINGLISTONCHANGE_R(Self: TSTRINGLIST; var T: TNOTIFYEVENT);
|
||||||
|
begin
|
||||||
|
T := Self.ONCHANGE; end;
|
||||||
|
procedure TSTRINGLISTONCHANGE_W(Self: TSTRINGLIST; const T: TNOTIFYEVENT);
|
||||||
|
begin
|
||||||
|
Self.ONCHANGE := T; end;
|
||||||
|
procedure TSTRINGLISTONCHANGING_R(Self: TSTRINGLIST; var T: TNOTIFYEVENT); begin T := Self.ONCHANGING; end;
|
||||||
|
procedure TSTRINGLISTONCHANGING_W(Self: TSTRINGLIST; const T: TNOTIFYEVENT); begin Self.ONCHANGING := T; end;
|
||||||
|
procedure RIRegisterTSTRINGLIST(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TSTRINGLIST) do
|
||||||
|
begin
|
||||||
|
RegisterVirtualMethod(@TSTRINGLIST.FIND, 'FIND');
|
||||||
|
RegisterVirtualMethod(@TSTRINGLIST.SORT, 'SORT');
|
||||||
|
RegisterPropertyHelper(@TSTRINGLISTDUPLICATES_R, @TSTRINGLISTDUPLICATES_W, 'DUPLICATES');
|
||||||
|
RegisterPropertyHelper(@TSTRINGLISTSORTED_R, @TSTRINGLISTSORTED_W, 'SORTED');
|
||||||
|
RegisterEventPropertyHelper(@TSTRINGLISTONCHANGE_R, @TSTRINGLISTONCHANGE_W, 'ONCHANGE');
|
||||||
|
RegisterEventPropertyHelper(@TSTRINGLISTONCHANGING_R, @TSTRINGLISTONCHANGING_W, 'ONCHANGING');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure TBITSBITS_W(Self: TBITS; T: BOOLEAN; t1: INTEGER); begin Self.BITS[t1] := T; end;
|
||||||
|
procedure TBITSBITS_R(Self: TBITS; var T: BOOLEAN; t1: INTEGER); begin T := Self.Bits[t1]; end;
|
||||||
|
procedure TBITSSIZE_R(Self: TBITS; T: INTEGER); begin Self.SIZE := T; end;
|
||||||
|
procedure TBITSSIZE_W(Self: TBITS; var T: INTEGER); begin T := Self.SIZE; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTBITS(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TBITS) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TBITS.OPENBIT, 'OPENBIT');
|
||||||
|
RegisterPropertyHelper(@TBITSBITS_R, @TBITSBITS_W, 'BITS');
|
||||||
|
RegisterPropertyHelper(@TBITSSIZE_R, @TBITSSIZE_W, 'SIZE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TSTREAMPOSITION_R(Self: TSTREAM; var T: LONGINT); begin t := Self.POSITION; end;
|
||||||
|
procedure TSTREAMPOSITION_W(Self: TSTREAM; T: LONGINT); begin Self.POSITION := t; end;
|
||||||
|
procedure TSTREAMSIZE_R(Self: TSTREAM; var T: LONGINT); begin t := Self.SIZE; end;
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure TSTREAMSIZE_W(Self: TSTREAM; T: LONGINT); begin Self.SIZE := t; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegisterTSTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TSTREAM) do
|
||||||
|
begin
|
||||||
|
RegisterVirtualAbstractMethod(TMemoryStream, @TMemoryStream.READ, 'READ');
|
||||||
|
RegisterVirtualAbstractMethod(TMemoryStream, @TMemoryStream.WRITE, 'WRITE');
|
||||||
|
RegisterVirtualAbstractMethod(TMemoryStream, @TMemoryStream.SEEK, 'SEEK');
|
||||||
|
RegisterMethod(@TSTREAM.READBUFFER, 'READBUFFER');
|
||||||
|
RegisterMethod(@TSTREAM.WRITEBUFFER, 'WRITEBUFFER');
|
||||||
|
RegisterMethod(@TSTREAM.COPYFROM, 'COPYFROM');
|
||||||
|
RegisterPropertyHelper(@TSTREAMPOSITION_R, @TSTREAMPOSITION_W, 'POSITION');
|
||||||
|
RegisterPropertyHelper(@TSTREAMSIZE_R, {$IFDEF DELPHI3UP}@TSTREAMSIZE_W, {$ELSE}nil, {$ENDIF}'SIZE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure THANDLESTREAMHANDLE_R(Self: THANDLESTREAM; var T: INTEGER); begin T := Self.HANDLE; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTHANDLESTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(THANDLESTREAM) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@THANDLESTREAM.CREATE, 'CREATE');
|
||||||
|
RegisterPropertyHelper(@THANDLESTREAMHANDLE_R, nil, 'HANDLE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
// mh: because FPC doesn't handle pointers to overloaded functions
|
||||||
|
function TFileStreamCreate(filename: string; mode: word): TFileStream;
|
||||||
|
begin
|
||||||
|
result := TFilestream.Create(filename, mode);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegisterTFILESTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TFILESTREAM) do
|
||||||
|
begin
|
||||||
|
{$IFDEF FPC}
|
||||||
|
RegisterConstructor(@TFileStreamCreate, 'CREATE');
|
||||||
|
{$ELSE}
|
||||||
|
RegisterConstructor(@TFILESTREAM.CREATE, 'CREATE');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
procedure RIRegisterTCUSTOMMEMORYSTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TCUSTOMMEMORYSTREAM) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TCUSTOMMEMORYSTREAM.SAVETOSTREAM, 'SAVETOSTREAM');
|
||||||
|
RegisterMethod(@TCUSTOMMEMORYSTREAM.SAVETOFILE, 'SAVETOFILE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTMEMORYSTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TMEMORYSTREAM) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TMEMORYSTREAM.CLEAR, 'CLEAR');
|
||||||
|
RegisterMethod(@TMEMORYSTREAM.LOADFROMSTREAM, 'LOADFROMSTREAM');
|
||||||
|
RegisterMethod(@TMEMORYSTREAM.LOADFROMFILE, 'LOADFROMFILE');
|
||||||
|
RegisterMethod(@TMEMORYSTREAM.SETSIZE, 'SETSIZE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTRESOURCESTREAM(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TRESOURCESTREAM) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TRESOURCESTREAM.CREATE, 'CREATE');
|
||||||
|
RegisterConstructor(@TRESOURCESTREAM.CREATEFROMID, 'CREATEFROMID');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPARSERSOURCELINE_R(Self: TPARSER; var T: INTEGER); begin T := Self.SOURCELINE; end;
|
||||||
|
procedure TPARSERTOKEN_R(Self: TPARSER; var T: CHAR); begin T := Self.TOKEN; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTPARSER(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TPARSER) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TPARSER.CREATE, 'CREATE');
|
||||||
|
RegisterMethod(@TPARSER.CHECKTOKEN, 'CHECKTOKEN');
|
||||||
|
RegisterMethod(@TPARSER.CHECKTOKENSYMBOL, 'CHECKTOKENSYMBOL');
|
||||||
|
RegisterMethod(@TPARSER.ERROR, 'ERROR');
|
||||||
|
RegisterMethod(@TPARSER.ERRORSTR, 'ERRORSTR');
|
||||||
|
RegisterMethod(@TPARSER.HEXTOBINARY, 'HEXTOBINARY');
|
||||||
|
RegisterMethod(@TPARSER.NEXTTOKEN, 'NEXTTOKEN');
|
||||||
|
RegisterMethod(@TPARSER.SOURCEPOS, 'SOURCEPOS');
|
||||||
|
RegisterMethod(@TPARSER.TOKENCOMPONENTIDENT, 'TOKENCOMPONENTIDENT');
|
||||||
|
RegisterMethod(@TPARSER.TOKENFLOAT, 'TOKENFLOAT');
|
||||||
|
RegisterMethod(@TPARSER.TOKENINT, 'TOKENINT');
|
||||||
|
RegisterMethod(@TPARSER.TOKENSTRING, 'TOKENSTRING');
|
||||||
|
RegisterMethod(@TPARSER.TOKENSYMBOLIS, 'TOKENSYMBOLIS');
|
||||||
|
RegisterPropertyHelper(@TPARSERSOURCELINE_R, nil, 'SOURCELINE');
|
||||||
|
RegisterPropertyHelper(@TPARSERTOKEN_R, nil, 'TOKEN');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCOLLECTIONITEMS_W(Self: TCOLLECTION; const T: TCOLLECTIONITEM; const t1: INTEGER);
|
||||||
|
begin Self.ITEMS[t1] := T; end;
|
||||||
|
|
||||||
|
procedure TCOLLECTIONITEMS_R(Self: TCOLLECTION; var T: TCOLLECTIONITEM; const t1: INTEGER);
|
||||||
|
begin T := Self.ITEMS[t1]; end;
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure TCOLLECTIONITEMCLASS_R(Self: TCOLLECTION; var T: TCOLLECTIONITEMCLASS);
|
||||||
|
begin T := Self.ITEMCLASS; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TCOLLECTIONCOUNT_R(Self: TCOLLECTION; var T: INTEGER);
|
||||||
|
begin T := Self.COUNT; end;
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure TCOLLECTIONITEMDISPLAYNAME_W(Self: TCOLLECTIONITEM; const T: STRING);
|
||||||
|
begin Self.DISPLAYNAME := T; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure TCOLLECTIONITEMDISPLAYNAME_R(Self: TCOLLECTIONITEM; var T: STRING);
|
||||||
|
begin T := Self.DISPLAYNAME; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TCOLLECTIONITEMINDEX_W(Self: TCOLLECTIONITEM; const T: INTEGER);
|
||||||
|
begin Self.INDEX := T; end;
|
||||||
|
|
||||||
|
procedure TCOLLECTIONITEMINDEX_R(Self: TCOLLECTIONITEM; var T: INTEGER);
|
||||||
|
begin T := Self.INDEX; end;
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure TCOLLECTIONITEMID_R(Self: TCOLLECTIONITEM; var T: INTEGER);
|
||||||
|
begin T := Self.ID; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TCOLLECTIONITEMCOLLECTION_W(Self: TCOLLECTIONITEM; const T: TCOLLECTION);
|
||||||
|
begin Self.COLLECTION := T; end;
|
||||||
|
|
||||||
|
procedure TCOLLECTIONITEMCOLLECTION_R(Self: TCOLLECTIONITEM; var T: TCOLLECTION);
|
||||||
|
begin T := Self.COLLECTION; end;
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
procedure RIRegisterTOWNEDCOLLECTION(Cl: TPSRuntimeClassImporter);
|
||||||
|
Begin
|
||||||
|
with Cl.Add(TOWNEDCOLLECTION) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TOWNEDCOLLECTION.CREATE, 'CREATE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegisterTCOLLECTION(Cl: TPSRuntimeClassImporter);
|
||||||
|
Begin
|
||||||
|
with Cl.Add(TCOLLECTION) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TCOLLECTION.CREATE, 'CREATE');
|
||||||
|
{$IFDEF DELPHI6UP} {$IFNDEF FPC} RegisterMethod(@TCOLLECTION.OWNER, 'OWNER'); {$ENDIF} {$ENDIF} // no owner in FPC
|
||||||
|
RegisterMethod(@TCOLLECTION.ADD, 'ADD');
|
||||||
|
RegisterVirtualMethod(@TCOLLECTION.BEGINUPDATE, 'BEGINUPDATE');
|
||||||
|
RegisterMethod(@TCOLLECTION.CLEAR, 'CLEAR');
|
||||||
|
{$IFDEF DELPHI5UP} RegisterMethod(@TCOLLECTION.DELETE, 'DELETE'); {$ENDIF}
|
||||||
|
RegisterVirtualMethod(@TCOLLECTION.ENDUPDATE, 'ENDUPDATE');
|
||||||
|
{$IFDEF DELPHI3UP} RegisterMethod(@TCOLLECTION.FINDITEMID, 'FINDITEMID'); {$ENDIF}
|
||||||
|
{$IFDEF DELPHI3UP} RegisterMethod(@TCOLLECTION.INSERT, 'INSERT'); {$ENDIF}
|
||||||
|
RegisterPropertyHelper(@TCOLLECTIONCOUNT_R,nil,'COUNT');
|
||||||
|
{$IFDEF DELPHI3UP} RegisterPropertyHelper(@TCOLLECTIONITEMCLASS_R,nil,'ITEMCLASS'); {$ENDIF}
|
||||||
|
RegisterPropertyHelper(@TCOLLECTIONITEMS_R,@TCOLLECTIONITEMS_W,'ITEMS');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTCOLLECTIONITEM(Cl: TPSRuntimeClassImporter);
|
||||||
|
Begin
|
||||||
|
with Cl.Add(TCOLLECTIONITEM) do
|
||||||
|
begin
|
||||||
|
RegisterVirtualConstructor(@TCOLLECTIONITEM.CREATE, 'CREATE');
|
||||||
|
RegisterPropertyHelper(@TCOLLECTIONITEMCOLLECTION_R,@TCOLLECTIONITEMCOLLECTION_W,'COLLECTION');
|
||||||
|
{$IFDEF DELPHI3UP} RegisterPropertyHelper(@TCOLLECTIONITEMID_R,nil,'ID'); {$ENDIF}
|
||||||
|
RegisterPropertyHelper(@TCOLLECTIONITEMINDEX_R,@TCOLLECTIONITEMINDEX_W,'INDEX');
|
||||||
|
{$IFDEF DELPHI3UP} RegisterPropertyHelper(@TCOLLECTIONITEMDISPLAYNAME_R,@TCOLLECTIONITEMDISPLAYNAME_W,'DISPLAYNAME'); {$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegister_Classes(Cl: TPSRuntimeClassImporter; Streams: Boolean);
|
||||||
|
begin
|
||||||
|
if Streams then
|
||||||
|
RIRegisterTSTREAM(Cl);
|
||||||
|
RIRegisterTStrings(cl, Streams);
|
||||||
|
RIRegisterTStringList(cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTBITS(cl);
|
||||||
|
{$ENDIF}
|
||||||
|
if Streams then
|
||||||
|
begin
|
||||||
|
RIRegisterTHANDLESTREAM(Cl);
|
||||||
|
RIRegisterTFILESTREAM(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTCUSTOMMEMORYSTREAM(Cl);
|
||||||
|
RIRegisterTMEMORYSTREAM(Cl);
|
||||||
|
RIRegisterTRESOURCESTREAM(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTPARSER(Cl);
|
||||||
|
RIRegisterTCOLLECTIONITEM(Cl);
|
||||||
|
RIRegisterTCOLLECTION(Cl);
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
RIRegisterTOWNEDCOLLECTION(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
end.
|
||||||
96
Units/PascalScript/uPSR_comobj.pas
Normal file
96
Units/PascalScript/uPSR_comobj.pas
Normal file
@ -0,0 +1,96 @@
|
|||||||
|
|
||||||
|
|
||||||
|
unit uPSR_comobj;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegister_ComObj(cl: TPSExec);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
{$IFDEF DELPHI3UP}
|
||||||
|
ComObj;
|
||||||
|
{$ELSE}
|
||||||
|
SysUtils, Ole2;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFNDEF DELPHI3UP}
|
||||||
|
|
||||||
|
{$IFDEF DELPHI3UP }
|
||||||
|
resourceString
|
||||||
|
{$ELSE }
|
||||||
|
const
|
||||||
|
{$ENDIF }
|
||||||
|
|
||||||
|
RPS_OLEError = 'OLE error %.8x';
|
||||||
|
function OleErrorMessage(ErrorCode: HResult): String;
|
||||||
|
begin
|
||||||
|
Result := SysErrorMessage(ErrorCode);
|
||||||
|
if Result = '' then
|
||||||
|
Result := Format(RPS_OLEError, [ErrorCode]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure OleError(ErrorCode: HResult);
|
||||||
|
begin
|
||||||
|
raise Exception.Create(OleErrorMessage(ErrorCode));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure OleCheck(Result: HResult);
|
||||||
|
begin
|
||||||
|
if Result < 0 then OleError(Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure CreateOleObject(const ClassName: string; var Disp: IDispatch);
|
||||||
|
var
|
||||||
|
OldDisp: IDispatch;
|
||||||
|
ClassID: TCLSID;
|
||||||
|
WideCharBuf: array[0..127] of WideChar;
|
||||||
|
begin
|
||||||
|
StringToWideChar(ClassName, WideCharBuf, SizeOf(WideCharBuf) div SizeOf(WideCharBuf[0]));
|
||||||
|
OleCheck(CLSIDFromProgID(WideCharBuf, ClassID));
|
||||||
|
if Disp <> nil then
|
||||||
|
begin
|
||||||
|
OldDisp := Disp;
|
||||||
|
Disp := nil;
|
||||||
|
OldDisp.Release;
|
||||||
|
end;
|
||||||
|
OleCheck(CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
|
||||||
|
CLSCTX_LOCAL_SERVER, IID_IDispatch, Disp));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure GetActiveOleObject(const ClassName: string; var Disp: IDispatch);
|
||||||
|
var
|
||||||
|
Unknown: IUnknown;
|
||||||
|
OldDisp: IDispatch;
|
||||||
|
ClassID: TCLSID;
|
||||||
|
WideCharBuf: array[0..127] of WideChar;
|
||||||
|
begin
|
||||||
|
StringToWideChar(ClassName, WideCharBuf, SizeOf(WideCharBuf) div SizeOf(WideCharBuf[0]));
|
||||||
|
OleCheck(CLSIDFromProgID(WideCharBuf, ClassID));
|
||||||
|
OleCheck(GetActiveObject(ClassID, nil, Unknown));
|
||||||
|
try
|
||||||
|
if Disp <> nil then
|
||||||
|
begin
|
||||||
|
OldDisp := Disp;
|
||||||
|
Disp := nil;
|
||||||
|
OldDisp.Release;
|
||||||
|
end;
|
||||||
|
OleCheck(Unknown.QueryInterface(IID_IDispatch, Disp));
|
||||||
|
finally
|
||||||
|
Unknown.Release;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegister_ComObj(cl: TPSExec);
|
||||||
|
begin
|
||||||
|
cl.RegisterDelphiFunction(@CreateOleObject, 'CREATEOLEOBJECT', cdRegister);
|
||||||
|
cl.RegisterDelphiFunction(@GetActiveOleObject, 'GETACTIVEOLEOBJECT', cdRegister);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
249
Units/PascalScript/uPSR_controls.pas
Normal file
249
Units/PascalScript/uPSR_controls.pas
Normal file
@ -0,0 +1,249 @@
|
|||||||
|
|
||||||
|
unit uPSR_controls;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTWinControl(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTGraphicControl(cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCustomControl(cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegister_TDragObject(CL: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
procedure RIRegister_Controls(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
uses
|
||||||
|
Classes{$IFDEF CLX}, QControls, QGraphics{$ELSE}, Controls, Graphics, Windows{$ENDIF};
|
||||||
|
{$ELSE}
|
||||||
|
uses
|
||||||
|
Classes, Controls, Graphics;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TControlAlignR(Self: TControl; var T: Byte); begin T := Byte(Self.Align); end;
|
||||||
|
procedure TControlAlignW(Self: TControl; T: Byte); begin Self.Align:= TAlign(T); end;
|
||||||
|
|
||||||
|
procedure TControlClientHeightR(Self: TControl; var T: Longint); begin T := Self.ClientHeight; end;
|
||||||
|
procedure TControlClientHeightW(Self: TControl; T: Longint); begin Self.ClientHeight := T; end;
|
||||||
|
|
||||||
|
procedure TControlClientWidthR(Self: TControl; var T: Longint); begin T := Self.ClientWidth; end;
|
||||||
|
procedure TControlClientWidthW(Self: TControl; T: Longint); begin Self.ClientWidth:= T; end;
|
||||||
|
|
||||||
|
procedure TControlShowHintR(Self: TControl; var T: Boolean); begin T := Self.ShowHint; end;
|
||||||
|
procedure TControlShowHintW(Self: TControl; T: Boolean); begin Self.ShowHint:= T; end;
|
||||||
|
|
||||||
|
procedure TControlVisibleR(Self: TControl; var T: Boolean); begin T := Self.Visible; end;
|
||||||
|
procedure TControlVisibleW(Self: TControl; T: Boolean); begin Self.Visible:= T; end;
|
||||||
|
|
||||||
|
procedure TControlParentR(Self: TControl; var T: TWinControl); begin T := Self.Parent; end;
|
||||||
|
procedure TControlParentW(Self: TControl; T: TWinControl); begin Self.Parent:= T; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TCONTROLSHOWHINT_W(Self: TCONTROL; T: BOOLEAN); begin Self.SHOWHINT := T; end;
|
||||||
|
procedure TCONTROLSHOWHINT_R(Self: TCONTROL; var T: BOOLEAN); begin T := Self.SHOWHINT; end;
|
||||||
|
procedure TCONTROLENABLED_W(Self: TCONTROL; T: BOOLEAN); begin Self.ENABLED := T; end;
|
||||||
|
procedure TCONTROLENABLED_R(Self: TCONTROL; var T: BOOLEAN); begin T := Self.ENABLED; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TControl) do
|
||||||
|
begin
|
||||||
|
RegisterVirtualConstructor(@TControl.Create, 'CREATE');
|
||||||
|
RegisterMethod(@TControl.BRingToFront, 'BRINGTOFRONT');
|
||||||
|
RegisterMethod(@TControl.Hide, 'HIDE');
|
||||||
|
RegisterVirtualMethod(@TControl.Invalidate, 'INVALIDATE');
|
||||||
|
RegisterMethod(@TControl.Refresh, 'REFRESH');
|
||||||
|
RegisterVirtualMethod(@TControl.Repaint, 'REPAINT');
|
||||||
|
RegisterMethod(@TControl.SendToBack, 'SENDTOBACK');
|
||||||
|
RegisterMethod(@TControl.Show, 'SHOW');
|
||||||
|
RegisterVirtualMethod(@TControl.Update, 'UPDATE');
|
||||||
|
RegisterVirtualMethod(@TControl.SetBounds, 'SETBOUNDS');
|
||||||
|
|
||||||
|
RegisterPropertyHelper(@TControlShowHintR, @TControlShowHintW, 'SHOWHINT');
|
||||||
|
RegisterPropertyHelper(@TControlAlignR, @TControlAlignW, 'ALIGN');
|
||||||
|
RegisterPropertyHelper(@TControlClientHeightR, @TControlClientHeightW, 'CLIENTHEIGHT');
|
||||||
|
RegisterPropertyHelper(@TControlClientWidthR, @TControlClientWidthW, 'CLIENTWIDTH');
|
||||||
|
RegisterPropertyHelper(@TControlVisibleR, @TControlVisibleW, 'VISIBLE');
|
||||||
|
RegisterPropertyHelper(@TCONTROLENABLED_R, @TCONTROLENABLED_W, 'ENABLED');
|
||||||
|
|
||||||
|
RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT');
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod(@TControl.Dragging, 'DRAGGING');
|
||||||
|
RegisterMethod(@TControl.HasParent, 'HASPARENT');
|
||||||
|
RegisterMethod(@TCONTROL.CLIENTTOSCREEN, 'CLIENTTOSCREEN');
|
||||||
|
RegisterMethod(@TCONTROL.DRAGGING, 'DRAGGING');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TCONTROL.BEGINDRAG, 'BEGINDRAG');
|
||||||
|
RegisterMethod(@TCONTROL.ENDDRAG, 'ENDDRAG');
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod(@TCONTROL.GETTEXTBUF, 'GETTEXTBUF');
|
||||||
|
RegisterMethod(@TCONTROL.GETTEXTLEN, 'GETTEXTLEN');
|
||||||
|
RegisterMethod(@TCONTROL.PERFORM, 'PERFORM');
|
||||||
|
RegisterMethod(@TCONTROL.SETTEXTBUF, 'SETTEXTBUF');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TCONTROL.SCREENTOCLIENT, 'SCREENTOCLIENT');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure TWinControlHandleR(Self: TWinControl; var T: Longint); begin T := Self.Handle; end;
|
||||||
|
{$ENDIF}
|
||||||
|
procedure TWinControlShowingR(Self: TWinControl; var T: Boolean); begin T := Self.Showing; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TWinControlTabOrderR(Self: TWinControl; var T: Longint); begin T := Self.TabOrder; end;
|
||||||
|
procedure TWinControlTabOrderW(Self: TWinControl; T: Longint); begin Self.TabOrder:= T; end;
|
||||||
|
|
||||||
|
procedure TWinControlTabStopR(Self: TWinControl; var T: Boolean); begin T := Self.TabStop; end;
|
||||||
|
procedure TWinControlTabStopW(Self: TWinControl; T: Boolean); begin Self.TabStop:= T; end;
|
||||||
|
procedure TWINCONTROLBRUSH_R(Self: TWINCONTROL; var T: TBRUSH); begin T := Self.BRUSH; end;
|
||||||
|
procedure TWINCONTROLCONTROLS_R(Self: TWINCONTROL; var T: TCONTROL; t1: INTEGER); begin t := Self.CONTROLS[t1]; end;
|
||||||
|
procedure TWINCONTROLCONTROLCOUNT_R(Self: TWINCONTROL; var T: INTEGER); begin t := Self.CONTROLCOUNT; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTWinControl(Cl: TPSRuntimeClassImporter); // requires TControl
|
||||||
|
begin
|
||||||
|
with Cl.Add(TWinControl) do
|
||||||
|
begin
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterPropertyHelper(@TWinControlHandleR, nil, 'HANDLE');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterPropertyHelper(@TWinControlShowingR, nil, 'SHOWING');
|
||||||
|
RegisterPropertyHelper(@TWinControlTabOrderR, @TWinControlTabOrderW, 'TABORDER');
|
||||||
|
RegisterPropertyHelper(@TWinControlTabStopR, @TWinControlTabStopW, 'TABSTOP');
|
||||||
|
RegisterMethod(@TWINCONTROL.CANFOCUS, 'CANFOCUS');
|
||||||
|
RegisterMethod(@TWINCONTROL.FOCUSED, 'FOCUSED');
|
||||||
|
RegisterPropertyHelper(@TWINCONTROLCONTROLS_R, nil, 'CONTROLS');
|
||||||
|
RegisterPropertyHelper(@TWINCONTROLCONTROLCOUNT_R, nil, 'CONTROLCOUNT');
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod(@TWinControl.HandleAllocated, 'HANDLEALLOCATED');
|
||||||
|
RegisterMethod(@TWinControl.HandleNeeded, 'HANDLENEEDED');
|
||||||
|
RegisterMethod(@TWinControl.EnableAlign, 'ENABLEALIGN');
|
||||||
|
RegisterMethod(@TWinControl.RemoveControl, 'REMOVECONTROL');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TWinControl.InsertControl, 'INSERTCONTROL');
|
||||||
|
RegisterMethod(@TWinControl.ScaleBy, 'SCALEBY');
|
||||||
|
RegisterMethod(@TWinControl.ScrollBy, 'SCROLLBY');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod(@TWINCONTROL.PAINTTO, 'PAINTTO');
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}{FPC}
|
||||||
|
RegisterMethod(@TWinControl.Realign, 'REALIGN');
|
||||||
|
RegisterVirtualMethod(@TWinControl.SetFocus, 'SETFOCUS');
|
||||||
|
RegisterMethod(@TWINCONTROL.CONTAINSCONTROL, 'CONTAINSCONTROL');
|
||||||
|
RegisterMethod(@TWINCONTROL.DISABLEALIGN, 'DISABLEALIGN');
|
||||||
|
RegisterMethod(@TWINCONTROL.UPDATECONTROLSTATE, 'UPDATECONTROLSTATE');
|
||||||
|
RegisterPropertyHelper(@TWINCONTROLBRUSH_R, nil, 'BRUSH');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTGraphicControl(cl: TPSRuntimeClassImporter); // requires TControl
|
||||||
|
begin
|
||||||
|
Cl.Add(TGraphicControl);
|
||||||
|
end;
|
||||||
|
procedure RIRegisterTCustomControl(cl: TPSRuntimeClassImporter); // requires TControl
|
||||||
|
begin
|
||||||
|
Cl.Add(TCustomControl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
(* === run-time registration functions === *)
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectMouseDeltaY_R(Self: TDragObject; var T: Double);
|
||||||
|
begin T := Self.MouseDeltaY; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectMouseDeltaX_R(Self: TDragObject; var T: Double);
|
||||||
|
begin T := Self.MouseDeltaX; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectDragTarget_W(Self: TDragObject; const T: Pointer);
|
||||||
|
begin Self.DragTarget := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectDragTarget_R(Self: TDragObject; var T: Pointer);
|
||||||
|
begin T := Self.DragTarget; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectDragTargetPos_W(Self: TDragObject; const T: TPoint);
|
||||||
|
begin Self.DragTargetPos := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectDragTargetPos_R(Self: TDragObject; var T: TPoint);
|
||||||
|
begin T := Self.DragTargetPos; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectDragPos_W(Self: TDragObject; const T: TPoint);
|
||||||
|
begin Self.DragPos := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectDragPos_R(Self: TDragObject; var T: TPoint);
|
||||||
|
begin T := Self.DragPos; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectDragHandle_W(Self: TDragObject; const T: HWND);
|
||||||
|
begin Self.DragHandle := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectDragHandle_R(Self: TDragObject; var T: HWND);
|
||||||
|
begin T := Self.DragHandle; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectCancelling_W(Self: TDragObject; const T: Boolean);
|
||||||
|
begin Self.Cancelling := T; end;
|
||||||
|
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure TDragObjectCancelling_R(Self: TDragObject; var T: Boolean);
|
||||||
|
begin T := Self.Cancelling; end;
|
||||||
|
{$ENDIF}
|
||||||
|
(*----------------------------------------------------------------------------*)
|
||||||
|
procedure RIRegister_TDragObject(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TDragObject) do
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
RegisterVirtualMethod(@TDragObject.Assign, 'Assign');
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterVirtualMethod(@TDragObject.GetName, 'GetName');
|
||||||
|
RegisterVirtualMethod(@TDragObject.Instance, 'Instance');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterVirtualMethod(@TDragObject.HideDragImage, 'HideDragImage');
|
||||||
|
RegisterVirtualMethod(@TDragObject.ShowDragImage, 'ShowDragImage');
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
RegisterPropertyHelper(@TDragObjectCancelling_R,@TDragObjectCancelling_W,'Cancelling');
|
||||||
|
RegisterPropertyHelper(@TDragObjectDragHandle_R,@TDragObjectDragHandle_W,'DragHandle');
|
||||||
|
RegisterPropertyHelper(@TDragObjectDragPos_R,@TDragObjectDragPos_W,'DragPos');
|
||||||
|
RegisterPropertyHelper(@TDragObjectDragTargetPos_R,@TDragObjectDragTargetPos_W,'DragTargetPos');
|
||||||
|
RegisterPropertyHelper(@TDragObjectDragTarget_R,@TDragObjectDragTarget_W,'DragTarget');
|
||||||
|
RegisterPropertyHelper(@TDragObjectMouseDeltaX_R,nil,'MouseDeltaX');
|
||||||
|
RegisterPropertyHelper(@TDragObjectMouseDeltaY_R,nil,'MouseDeltaY');
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegister_Controls(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegisterTControl(Cl);
|
||||||
|
RIRegisterTWinControl(Cl);
|
||||||
|
RIRegisterTGraphicControl(cl);
|
||||||
|
RIRegisterTCustomControl(cl);
|
||||||
|
RIRegister_TDragObject(cl);
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
63
Units/PascalScript/uPSR_dateutils.pas
Normal file
63
Units/PascalScript/uPSR_dateutils.pas
Normal file
@ -0,0 +1,63 @@
|
|||||||
|
|
||||||
|
unit uPSR_dateutils;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
SysUtils, uPSRuntime;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RegisterDateTimeLibrary_R(S: TPSExec);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function TryEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Date := EncodeDate(Year, Month, Day);
|
||||||
|
Result := true;
|
||||||
|
except
|
||||||
|
Result := false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TryEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Time := EncodeTime(hour, Min, Sec, MSec);
|
||||||
|
Result := true;
|
||||||
|
except
|
||||||
|
Result := false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DateTimeToUnix(D: TDateTime): Int64;
|
||||||
|
begin
|
||||||
|
Result := Round((D - 25569) * 86400);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function UnixToDateTime(U: Int64): TDateTime;
|
||||||
|
begin
|
||||||
|
Result := U / 86400 + 25569;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RegisterDateTimeLibrary_R(S: TPSExec);
|
||||||
|
begin
|
||||||
|
S.RegisterDelphiFunction(@EncodeDate, 'ENCODEDATE', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@EncodeTime, 'ENCODETIME', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@TryEncodeDate, 'TRYENCODEDATE', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@TryEncodeTime, 'TRYENCODETIME', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@DecodeDate, 'DECODEDATE', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@DecodeTime, 'DECODETIME', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@DayOfWeek, 'DAYOFWEEK', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@Date, 'DATE', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@Time, 'TIME', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@Now, 'NOW', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@DateTimeToUnix, 'DATETIMETOUNIX', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@UnixToDateTime, 'UNIXTODATETIME', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@DateToStr, 'DATETOSTR', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@FormatDateTime, 'FORMATDATETIME', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@StrToDate, 'STRTODATE', cdRegister);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
312
Units/PascalScript/uPSR_dll.pas
Normal file
312
Units/PascalScript/uPSR_dll.pas
Normal file
@ -0,0 +1,312 @@
|
|||||||
|
|
||||||
|
unit uPSR_dll;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
procedure RegisterDLLRuntime(Caller: TPSExec);
|
||||||
|
procedure RegisterDLLRuntimeEx(Caller: TPSExec; AddDllProcImport: Boolean);
|
||||||
|
|
||||||
|
function ProcessDllImport(Caller: TPSExec; P: TPSExternalProcRec): Boolean;
|
||||||
|
function ProcessDllImportEx(Caller: TPSExec; P: TPSExternalProcRec; ForceDelayLoad: Boolean): Boolean;
|
||||||
|
function UnloadProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}
|
||||||
|
{$IFDEF Darwin}
|
||||||
|
LCLIntf, Unix, baseunix, dynlibs, termio, sockets;
|
||||||
|
{$ELSE}
|
||||||
|
LibC{$IFNDEF FPC}, Windows{$ENDIF};
|
||||||
|
{$ENDIF}
|
||||||
|
{$ELSE}
|
||||||
|
Windows;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{
|
||||||
|
p^.Ext1 contains the pointer to the Proc function
|
||||||
|
p^.ExportDecl:
|
||||||
|
'dll:'+DllName+#0+FunctionName+#0+chr(Cc)+Chr(DelayLoad)+Chr(AlternateSearchPath)+VarParams
|
||||||
|
}
|
||||||
|
|
||||||
|
type
|
||||||
|
PLoadedDll = ^TLoadedDll;
|
||||||
|
TLoadedDll = record
|
||||||
|
dllnamehash: Longint;
|
||||||
|
dllname: tbtstring;
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
dllhandle: Pointer;
|
||||||
|
{$ELSE}
|
||||||
|
dllhandle: THandle;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
TMyExec = class(TPSExec);
|
||||||
|
PInteger = ^Integer;
|
||||||
|
|
||||||
|
procedure LAstErrorFree(Sender: TPSExec; P: PInteger);
|
||||||
|
begin
|
||||||
|
dispose(p);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure DLLSetLastError(Sender: TPSExec; P: Integer);
|
||||||
|
var
|
||||||
|
pz: PInteger;
|
||||||
|
begin
|
||||||
|
pz := Sender.FindProcResource(@LastErrorFree);
|
||||||
|
if pz = nil then
|
||||||
|
begin
|
||||||
|
new(pz);
|
||||||
|
Sender.AddResource(@LastErrorFree, PZ);
|
||||||
|
end;
|
||||||
|
pz^ := p;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DLLGetLastError(Sender: TPSExec): Integer;
|
||||||
|
var
|
||||||
|
pz: PInteger;
|
||||||
|
begin
|
||||||
|
pz := Sender.FindProcResource(@LastErrorFree);
|
||||||
|
if pz = nil then
|
||||||
|
result := 0
|
||||||
|
else
|
||||||
|
result := pz^;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure DllFree(Sender: TPSExec; P: PLoadedDll);
|
||||||
|
begin
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
dlclose(p^.dllhandle);
|
||||||
|
{$ELSE}
|
||||||
|
FreeLibrary(p^.dllhandle);
|
||||||
|
{$ENDIF}
|
||||||
|
Dispose(p);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LoadDll(Caller: TPSExec; P: TPSExternalProcRec): Boolean;
|
||||||
|
var
|
||||||
|
s, s2, s3: tbtstring;
|
||||||
|
h, i: Longint;
|
||||||
|
ph: PLoadedDll;
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
dllhandle: Pointer;
|
||||||
|
{$ELSE}
|
||||||
|
dllhandle: THandle;
|
||||||
|
{$ENDIF}
|
||||||
|
loadwithalteredsearchpath: Boolean;
|
||||||
|
begin
|
||||||
|
s := p.Decl;
|
||||||
|
Delete(s, 1, 4);
|
||||||
|
s2 := copy(s, 1, pos(tbtchar(#0), s)-1);
|
||||||
|
delete(s, 1, length(s2)+1);
|
||||||
|
h := makehash(s2);
|
||||||
|
s3 := copy(s, 1, pos(tbtchar(#0), s)-1);
|
||||||
|
delete(s, 1, length(s3)+1);
|
||||||
|
loadwithalteredsearchpath := bytebool(s[3]);
|
||||||
|
i := 2147483647; // maxint
|
||||||
|
dllhandle := 0;
|
||||||
|
repeat
|
||||||
|
ph := Caller.FindProcResource2(@dllFree, i);
|
||||||
|
if (ph = nil) then
|
||||||
|
begin
|
||||||
|
if s2 = '' then
|
||||||
|
begin
|
||||||
|
// don't pass an empty filename to LoadLibrary, just treat it as uncallable
|
||||||
|
p.Ext2 := Pointer(1);
|
||||||
|
Result := False;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{$IFDEF UNIX}
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
dllhandle := LoadLibrary(PChar(s2));
|
||||||
|
{$ELSE}
|
||||||
|
dllhandle := dlopen(PChar(s2), RTLD_LAZY);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ELSE}
|
||||||
|
if loadwithalteredsearchpath then
|
||||||
|
dllhandle := LoadLibraryExA(PAnsiChar(AnsiString(s2)), 0, LOAD_WITH_ALTERED_SEARCH_PATH)
|
||||||
|
else
|
||||||
|
dllhandle := LoadLibraryA(PAnsiChar(AnsiString(s2)));
|
||||||
|
{$ENDIF}
|
||||||
|
if dllhandle = {$IFDEF LINUX}nil{$ELSE}0{$ENDIF}then
|
||||||
|
begin
|
||||||
|
p.Ext2 := Pointer(1);
|
||||||
|
Result := False;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
new(ph);
|
||||||
|
ph^.dllnamehash := h;
|
||||||
|
ph^.dllname := s2;
|
||||||
|
ph^.dllhandle := dllhandle;
|
||||||
|
Caller.AddResource(@DllFree, ph);
|
||||||
|
end;
|
||||||
|
if (ph^.dllnamehash = h) and (ph^.dllname = s2) then
|
||||||
|
begin
|
||||||
|
dllhandle := ph^.dllhandle;
|
||||||
|
end;
|
||||||
|
until dllhandle <> {$IFDEF LINUX}nil{$ELSE}0{$ENDIF};
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
p.Ext1 := dlsym(dllhandle, pchar(s3));
|
||||||
|
{$ELSE}
|
||||||
|
p.Ext1 := GetProcAddress(dllhandle, pansichar(s3));
|
||||||
|
{$ENDIF}
|
||||||
|
if p.Ext1 = nil then
|
||||||
|
begin
|
||||||
|
p.Ext2 := Pointer(1);
|
||||||
|
Result := false;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function DllProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||||
|
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
MyList: TIfList;
|
||||||
|
n: PPSVariantIFC;
|
||||||
|
CurrStack: Cardinal;
|
||||||
|
cc: TPSCallingConvention;
|
||||||
|
s: tbtstring;
|
||||||
|
begin
|
||||||
|
if p.Ext2 <> nil then // error
|
||||||
|
begin
|
||||||
|
Result := false;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if p.Ext1 = nil then
|
||||||
|
begin
|
||||||
|
if not LoadDll(Caller, P) then
|
||||||
|
begin
|
||||||
|
Result := false;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
s := p.Decl;
|
||||||
|
delete(S, 1, pos(tbtchar(#0), s));
|
||||||
|
delete(S, 1, pos(tbtchar(#0), s));
|
||||||
|
if length(S) < 2 then
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
cc := TPSCallingConvention(s[1]);
|
||||||
|
delete(s, 1, 3); // cc + delayload + alternatesearchpath (delayload might also be forced!)
|
||||||
|
CurrStack := Cardinal(Stack.Count) - Cardinal(length(s));
|
||||||
|
if s[1] = #0 then inc(CurrStack);
|
||||||
|
MyList := tIfList.Create;
|
||||||
|
for i := 2 to length(s) do
|
||||||
|
begin
|
||||||
|
MyList.Add(nil);
|
||||||
|
end;
|
||||||
|
for i := length(s) downto 2 do
|
||||||
|
begin
|
||||||
|
MyList[i - 2] := NewPPSVariantIFC(Stack[CurrStack], s[i] <> #0);
|
||||||
|
inc(CurrStack);
|
||||||
|
end;
|
||||||
|
if s[1] <> #0 then
|
||||||
|
begin
|
||||||
|
n := NewPPSVariantIFC(Stack[CurrStack], true);
|
||||||
|
end else n := nil;
|
||||||
|
try
|
||||||
|
TMYExec(Caller).InnerfuseCall(nil, p.Ext1, cc, MyList, n);
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
DLLSetLastError(Caller, GetLastError);
|
||||||
|
{$ENDIF}
|
||||||
|
finally
|
||||||
|
DisposePPSvariantIFC(n);
|
||||||
|
DisposePPSVariantIFCList(MyList);
|
||||||
|
end;
|
||||||
|
result := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ProcessDllImport(Caller: TPSExec; P: TPSExternalProcRec): Boolean;
|
||||||
|
begin
|
||||||
|
Result := ProcessDllImportEx(Caller, P, False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ProcessDllImportEx(Caller: TPSExec; P: TPSExternalProcRec; ForceDelayLoad: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
DelayLoad: Boolean;
|
||||||
|
s: tbtstring;
|
||||||
|
begin
|
||||||
|
if not ForceDelayLoad then begin
|
||||||
|
s := p.Decl;
|
||||||
|
Delete(s,1,pos(tbtchar(#0), s));
|
||||||
|
Delete(s,1,pos(tbtchar(#0), s));
|
||||||
|
DelayLoad := bytebool(s[2]);
|
||||||
|
end else
|
||||||
|
DelayLoad := True;
|
||||||
|
|
||||||
|
if DelayLoad then begin
|
||||||
|
p.ProcPtr := DllProc;
|
||||||
|
Result := True;
|
||||||
|
end else begin
|
||||||
|
p.ProcPtr := DllProc;
|
||||||
|
Result := LoadDll(Caller, p);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetLastErrorProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||||
|
begin
|
||||||
|
Stack.SetInt(-1, DLLGetLastError(Caller));
|
||||||
|
Result := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function UnloadProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||||
|
var
|
||||||
|
h, i: Longint;
|
||||||
|
pv: TPSProcRec;
|
||||||
|
ph: PLoadedDll;
|
||||||
|
sname, s: tbtstring;
|
||||||
|
begin
|
||||||
|
sname := Stack.GetAnsiString(-1);
|
||||||
|
for i := Caller.GetProcCount -1 downto 0 do
|
||||||
|
begin
|
||||||
|
pv := Caller.GetProcNo(i);
|
||||||
|
if not (pv is TPSExternalProcRec) then continue;
|
||||||
|
if @TPSExternalProcRec(pv).ProcPtr <> @DllProc then continue;
|
||||||
|
s := (TPSExternalProcRec(pv).Decl);
|
||||||
|
delete(s,1,4);
|
||||||
|
if copy(s,1,pos(tbtchar(#0),s)-1) = sname then
|
||||||
|
begin
|
||||||
|
TPSExternalProcRec(pv).Ext1 := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
h := MakeHash(sname);
|
||||||
|
i := 2147483647; // maxint
|
||||||
|
repeat
|
||||||
|
ph := Caller.FindProcResource2(@dllFree, i);
|
||||||
|
if (ph = nil) then break;
|
||||||
|
if (ph.dllnamehash = h) and (ph.dllname = sname) then
|
||||||
|
begin
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
dlclose(ph^.dllhandle);
|
||||||
|
{$ELSE}
|
||||||
|
FreeLibrary(ph^.dllhandle);
|
||||||
|
{$ENDIF}
|
||||||
|
Caller.DeleteResource(ph);
|
||||||
|
dispose(ph);
|
||||||
|
end;
|
||||||
|
until false;
|
||||||
|
result := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RegisterDLLRuntime(Caller: TPSExec);
|
||||||
|
begin
|
||||||
|
RegisterDLLRuntimeEx(Caller, True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RegisterDLLRuntimeEx(Caller: TPSExec; AddDllProcImport: Boolean);
|
||||||
|
begin
|
||||||
|
if AddDllProcImport then
|
||||||
|
Caller.AddSpecialProcImport('dll', @ProcessDllImport, nil);
|
||||||
|
Caller.RegisterFunctionName('UNLOADDLL', UnloadProc, nil, nil);
|
||||||
|
Caller.RegisterFunctionName('DLLGETLASTERROR', GetLastErrorProc, nil, nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
150
Units/PascalScript/uPSR_extctrls.pas
Normal file
150
Units/PascalScript/uPSR_extctrls.pas
Normal file
@ -0,0 +1,150 @@
|
|||||||
|
|
||||||
|
unit uPSR_extctrls;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegister_ExtCtrls(cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
procedure RIRegisterTSHAPE(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTIMAGE(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTPAINTBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTBEVEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTTIMER(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCUSTOMPANEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTPANEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure RIRegisterTPAGE(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTNOTEBOOK(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$IFNDEF FPC}procedure RIRegisterTHEADER(Cl: TPSRuntimeClassImporter);{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
procedure RIRegisterTCUSTOMRADIOGROUP(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTRADIOGROUP(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF CLX}
|
||||||
|
QExtCtrls, QGraphics;
|
||||||
|
{$ELSE}
|
||||||
|
ExtCtrls, Graphics;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegisterTSHAPE(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TSHAPE) do
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod(@TSHAPE.STYLECHANGED, 'STYLECHANGED');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIMAGECANVAS_R(Self: TIMAGE; var T: TCANVAS); begin T := Self.CANVAS; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTIMAGE(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TIMAGE) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TIMAGECANVAS_R, nil, 'CANVAS');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPAINTBOXCANVAS_R(Self: TPAINTBOX; var T: TCanvas); begin T := Self.CANVAS; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTPAINTBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TPAINTBOX) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TPAINTBOXCANVAS_R, nil, 'CANVAS');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTBEVEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TBEVEL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTTIMER(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TTIMER);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMPANEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TCUSTOMPANEL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTPANEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TPANEL);
|
||||||
|
end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure RIRegisterTPAGE(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TPAGE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTNOTEBOOK(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TNOTEBOOK);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure THEADERSECTIONWIDTH_R(Self: THEADER; var T: INTEGER; t1: INTEGER); begin T := Self.SECTIONWIDTH[t1]; end;
|
||||||
|
procedure THEADERSECTIONWIDTH_W(Self: THEADER; T: INTEGER; t1: INTEGER); begin Self.SECTIONWIDTH[t1] := T; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTHEADER(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(THEADER) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@THEADERSECTIONWIDTH_R, @THEADERSECTIONWIDTH_W, 'SECTIONWIDTH');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMRADIOGROUP(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TCUSTOMRADIOGROUP);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTRADIOGROUP(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TRADIOGROUP);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegister_ExtCtrls(cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTSHAPE(Cl);
|
||||||
|
RIRegisterTIMAGE(Cl);
|
||||||
|
RIRegisterTPAINTBOX(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
RIRegisterTBEVEL(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTTIMER(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
RIRegisterTCUSTOMPANEL(Cl);
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RIRegisterTPANEL(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RIRegisterTPAGE(Cl);
|
||||||
|
RIRegisterTNOTEBOOK(Cl);
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RIRegisterTHEADER(Cl);
|
||||||
|
{$ENDIF}{FPC}
|
||||||
|
{$ENDIF}
|
||||||
|
RIRegisterTCUSTOMRADIOGROUP(Cl);
|
||||||
|
RIRegisterTRADIOGROUP(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
264
Units/PascalScript/uPSR_forms.pas
Normal file
264
Units/PascalScript/uPSR_forms.pas
Normal file
@ -0,0 +1,264 @@
|
|||||||
|
|
||||||
|
unit uPSR_forms;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
procedure RIRegisterTCONTROLSCROLLBAR(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$IFNDEF FPC} procedure RIRegisterTSCROLLINGWINCONTROL(Cl: TPSRuntimeClassImporter);{$ENDIF}
|
||||||
|
procedure RIRegisterTSCROLLBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTFORM(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTAPPLICATION(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
procedure RIRegister_Forms(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
sysutils, classes, {$IFDEF CLX}QControls, QForms, QGraphics{$ELSE}Controls, Forms, Graphics{$ENDIF};
|
||||||
|
|
||||||
|
procedure TCONTROLSCROLLBARKIND_R(Self: TCONTROLSCROLLBAR; var T: TSCROLLBARKIND); begin T := Self.KIND; end;
|
||||||
|
procedure TCONTROLSCROLLBARSCROLLPOS_R(Self: TCONTROLSCROLLBAR; var T: INTEGER); begin t := Self.SCROLLPOS; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTCONTROLSCROLLBAR(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TCONTROLSCROLLBAR) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TCONTROLSCROLLBARKIND_R, nil, 'KIND');
|
||||||
|
RegisterPropertyHelper(@TCONTROLSCROLLBARSCROLLPOS_R, nil, 'SCROLLPOS');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure RIRegisterTSCROLLINGWINCONTROL(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TSCROLLINGWINCONTROL) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TSCROLLINGWINCONTROL.SCROLLINVIEW, 'SCROLLINVIEW');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegisterTSCROLLBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TSCROLLBOX);
|
||||||
|
end;
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure TFORMACTIVEOLECONTROL_W(Self: TFORM; T: TWINCONTROL); begin Self.ACTIVEOLECONTROL := T; end;
|
||||||
|
procedure TFORMACTIVEOLECONTROL_R(Self: TFORM; var T: TWINCONTROL); begin T := Self.ACTIVEOLECONTROL;
|
||||||
|
end;
|
||||||
|
procedure TFORMTILEMODE_W(Self: TFORM; T: TTILEMODE); begin Self.TILEMODE := T; end;
|
||||||
|
procedure TFORMTILEMODE_R(Self: TFORM; var T: TTILEMODE); begin T := Self.TILEMODE; end;
|
||||||
|
{$ENDIF}{CLX}
|
||||||
|
procedure TFORMACTIVEMDICHILD_R(Self: TFORM; var T: TFORM); begin T := Self.ACTIVEMDICHILD; end;
|
||||||
|
procedure TFORMDROPTARGET_W(Self: TFORM; T: BOOLEAN); begin Self.DROPTARGET := T; end;
|
||||||
|
procedure TFORMDROPTARGET_R(Self: TFORM; var T: BOOLEAN); begin T := Self.DROPTARGET; end;
|
||||||
|
procedure TFORMMDICHILDCOUNT_R(Self: TFORM; var T: INTEGER); begin T := Self.MDICHILDCOUNT; end;
|
||||||
|
procedure TFORMMDICHILDREN_R(Self: TFORM; var T: TFORM; t1: INTEGER); begin T := Self.MDICHILDREN[T1];
|
||||||
|
end;
|
||||||
|
{$ENDIF}{FPC}
|
||||||
|
|
||||||
|
procedure TFORMMODALRESULT_W(Self: TFORM; T: TMODALRESULT); begin Self.MODALRESULT := T; end;
|
||||||
|
procedure TFORMMODALRESULT_R(Self: TFORM; var T: TMODALRESULT); begin T := Self.MODALRESULT; end;
|
||||||
|
procedure TFORMACTIVE_R(Self: TFORM; var T: BOOLEAN); begin T := Self.ACTIVE; end;
|
||||||
|
procedure TFORMCANVAS_R(Self: TFORM; var T: TCANVAS); begin T := Self.CANVAS; end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure TFORMCLIENTHANDLE_R(Self: TFORM; var T: Longint); begin T := Self.CLIENTHANDLE; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ Innerfuse Pascal Script Class Import Utility (runtime) }
|
||||||
|
|
||||||
|
procedure RIRegisterTFORM(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TFORM) do
|
||||||
|
begin
|
||||||
|
{$IFDEF DELPHI4UP}
|
||||||
|
RegisterVirtualConstructor(@TFORM.CREATENEW, 'CREATENEW');
|
||||||
|
{$ELSE}
|
||||||
|
RegisterConstructor(@TFORM.CREATENEW, 'CREATENEW');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TFORM.CLOSE, 'CLOSE');
|
||||||
|
RegisterMethod(@TFORM.HIDE, 'HIDE');
|
||||||
|
RegisterMethod(@TFORM.SHOW, 'SHOW');
|
||||||
|
RegisterMethod(@TFORM.SHOWMODAL, 'SHOWMODAL');
|
||||||
|
RegisterMethod(@TFORM.RELEASE, 'RELEASE');
|
||||||
|
RegisterPropertyHelper(@TFORMACTIVE_R, nil, 'ACTIVE');
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod(@TFORM.ARRANGEICONS, 'ARRANGEICONS');
|
||||||
|
RegisterMethod(@TFORM.GETFORMIMAGE, 'GETFORMIMAGE');
|
||||||
|
RegisterMethod(@TFORM.PRINT, 'PRINT');
|
||||||
|
RegisterMethod(@TFORM.SENDCANCELMODE, 'SENDCANCELMODE');
|
||||||
|
RegisterPropertyHelper(@TFORMACTIVEOLECONTROL_R, @TFORMACTIVEOLECONTROL_W, 'ACTIVEOLECONTROL');
|
||||||
|
RegisterPropertyHelper(@TFORMCLIENTHANDLE_R, nil, 'CLIENTHANDLE');
|
||||||
|
RegisterPropertyHelper(@TFORMTILEMODE_R, @TFORMTILEMODE_W, 'TILEMODE');
|
||||||
|
{$ENDIF}{CLX}
|
||||||
|
RegisterMethod(@TFORM.CASCADE, 'CASCADE');
|
||||||
|
RegisterMethod(@TFORM.NEXT, 'NEXT');
|
||||||
|
RegisterMethod(@TFORM.PREVIOUS, 'PREVIOUS');
|
||||||
|
RegisterMethod(@TFORM.TILE, 'TILE');
|
||||||
|
RegisterPropertyHelper(@TFORMACTIVEMDICHILD_R, nil, 'ACTIVEMDICHILD');
|
||||||
|
RegisterPropertyHelper(@TFORMDROPTARGET_R, @TFORMDROPTARGET_W, 'DROPTARGET');
|
||||||
|
RegisterPropertyHelper(@TFORMMDICHILDCOUNT_R, nil, 'MDICHILDCOUNT');
|
||||||
|
RegisterPropertyHelper(@TFORMMDICHILDREN_R, nil, 'MDICHILDREN');
|
||||||
|
{$ENDIF}{FPC}
|
||||||
|
RegisterMethod(@TFORM.CLOSEQUERY, 'CLOSEQUERY');
|
||||||
|
RegisterMethod(@TFORM.DEFOCUSCONTROL, 'DEFOCUSCONTROL');
|
||||||
|
RegisterMethod(@TFORM.FOCUSCONTROL, 'FOCUSCONTROL');
|
||||||
|
RegisterMethod(@TFORM.SETFOCUSEDCONTROL, 'SETFOCUSEDCONTROL');
|
||||||
|
RegisterPropertyHelper(@TFORMCANVAS_R, nil, 'CANVAS');
|
||||||
|
RegisterPropertyHelper(@TFORMMODALRESULT_R, @TFORMMODALRESULT_W, 'MODALRESULT');
|
||||||
|
{$ENDIF}{PS_MINIVCL}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TAPPLICATIONACTIVE_R(Self: TAPPLICATION; var T: BOOLEAN); begin T := Self.ACTIVE; end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure TAPPLICATIONDIALOGHANDLE_R(Self: TAPPLICATION; var T: Longint); begin T := Self.DIALOGHANDLE; end;
|
||||||
|
procedure TAPPLICATIONDIALOGHANDLE_W(Self: TAPPLICATION; T: Longint); begin Self.DIALOGHANDLE := T; end;
|
||||||
|
procedure TAPPLICATIONHANDLE_R(Self: TAPPLICATION; var T: Longint); begin T := Self.HANDLE; end;
|
||||||
|
procedure TAPPLICATIONHANDLE_W(Self: TAPPLICATION; T: Longint); begin Self.HANDLE := T; end;
|
||||||
|
procedure TAPPLICATIONUPDATEFORMATSETTINGS_R(Self: TAPPLICATION; var T: BOOLEAN); begin T := Self.UPDATEFORMATSETTINGS; end;
|
||||||
|
procedure TAPPLICATIONUPDATEFORMATSETTINGS_W(Self: TAPPLICATION; T: BOOLEAN); begin Self.UPDATEFORMATSETTINGS := T; end;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}{FPC}
|
||||||
|
|
||||||
|
|
||||||
|
procedure TAPPLICATIONEXENAME_R(Self: TAPPLICATION; var T: STRING); begin T := Self.EXENAME; end;
|
||||||
|
procedure TAPPLICATIONHELPFILE_R(Self: TAPPLICATION; var T: STRING); begin T := Self.HELPFILE; end;
|
||||||
|
procedure TAPPLICATIONHELPFILE_W(Self: TAPPLICATION; T: STRING); begin Self.HELPFILE := T; end;
|
||||||
|
procedure TAPPLICATIONHINT_R(Self: TAPPLICATION; var T: STRING); begin T := Self.HINT; end;
|
||||||
|
procedure TAPPLICATIONHINT_W(Self: TAPPLICATION; T: STRING); begin Self.HINT := T; end;
|
||||||
|
procedure TAPPLICATIONHINTCOLOR_R(Self: TAPPLICATION; var T: TCOLOR); begin T := Self.HINTCOLOR; end;
|
||||||
|
procedure TAPPLICATIONHINTCOLOR_W(Self: TAPPLICATION; T: TCOLOR); begin Self.HINTCOLOR := T; end;
|
||||||
|
procedure TAPPLICATIONHINTPAUSE_R(Self: TAPPLICATION; var T: INTEGER); begin T := Self.HINTPAUSE; end;
|
||||||
|
procedure TAPPLICATIONHINTPAUSE_W(Self: TAPPLICATION; T: INTEGER); begin Self.HINTPAUSE := T; end;
|
||||||
|
procedure TAPPLICATIONHINTSHORTPAUSE_R(Self: TAPPLICATION; var T: INTEGER); begin T := Self.HINTSHORTPAUSE; end;
|
||||||
|
procedure TAPPLICATIONHINTSHORTPAUSE_W(Self: TAPPLICATION; T: INTEGER); begin Self.HINTSHORTPAUSE := T; end;
|
||||||
|
procedure TAPPLICATIONHINTHIDEPAUSE_R(Self: TAPPLICATION; var T: INTEGER); begin T := Self.HINTHIDEPAUSE; end;
|
||||||
|
procedure TAPPLICATIONHINTHIDEPAUSE_W(Self: TAPPLICATION; T: INTEGER); begin Self.HINTHIDEPAUSE := T; end;
|
||||||
|
procedure TAPPLICATIONMAINFORM_R(Self: TAPPLICATION; var T: {$IFDEF DELPHI3UP}TCustomForm{$ELSE}TFORM{$ENDIF}); begin T := Self.MAINFORM; end;
|
||||||
|
procedure TAPPLICATIONSHOWHINT_R(Self: TAPPLICATION; var T: BOOLEAN); begin T := Self.SHOWHINT; end;
|
||||||
|
procedure TAPPLICATIONSHOWHINT_W(Self: TAPPLICATION; T: BOOLEAN); begin Self.SHOWHINT := T; end;
|
||||||
|
procedure TAPPLICATIONSHOWMAINFORM_R(Self: TAPPLICATION; var T: BOOLEAN); begin T := Self.SHOWMAINFORM; end;
|
||||||
|
procedure TAPPLICATIONSHOWMAINFORM_W(Self: TAPPLICATION; T: BOOLEAN); begin Self.SHOWMAINFORM := T; end;
|
||||||
|
procedure TAPPLICATIONTERMINATED_R(Self: TAPPLICATION; var T: BOOLEAN); begin T := Self.TERMINATED; end;
|
||||||
|
procedure TAPPLICATIONTITLE_R(Self: TAPPLICATION; var T: STRING); begin T := Self.TITLE; end;
|
||||||
|
procedure TAPPLICATIONTITLE_W(Self: TAPPLICATION; T: STRING); begin Self.TITLE := T; end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TAPPLICATIONONACTIVATE_R(Self: TAPPLICATION; var T: TNOTIFYEVENT); begin T := Self.ONACTIVATE; end;
|
||||||
|
procedure TAPPLICATIONONACTIVATE_W(Self: TAPPLICATION; T: TNOTIFYEVENT); begin Self.ONACTIVATE := T; end;
|
||||||
|
procedure TAPPLICATIONONDEACTIVATE_R(Self: TAPPLICATION; var T: TNOTIFYEVENT); begin T := Self.ONDEACTIVATE; end;
|
||||||
|
procedure TAPPLICATIONONDEACTIVATE_W(Self: TAPPLICATION; T: TNOTIFYEVENT); begin Self.ONDEACTIVATE := T; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TAPPLICATIONONIDLE_R(Self: TAPPLICATION; var T: TIDLEEVENT); begin T := Self.ONIDLE; end;
|
||||||
|
procedure TAPPLICATIONONIDLE_W(Self: TAPPLICATION; T: TIDLEEVENT); begin Self.ONIDLE := T; end;
|
||||||
|
procedure TAPPLICATIONONHELP_R(Self: TAPPLICATION; var T: THELPEVENT); begin T := Self.ONHELP; end;
|
||||||
|
procedure TAPPLICATIONONHELP_W(Self: TAPPLICATION; T: THELPEVENT); begin Self.ONHELP := T; end;
|
||||||
|
procedure TAPPLICATIONONHINT_R(Self: TAPPLICATION; var T: TNOTIFYEVENT); begin T := Self.ONHINT; end;
|
||||||
|
procedure TAPPLICATIONONHINT_W(Self: TAPPLICATION; T: TNOTIFYEVENT); begin Self.ONHINT := T; end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TAPPLICATIONONMINIMIZE_R(Self: TAPPLICATION; var T: TNOTIFYEVENT); begin T := Self.ONMINIMIZE; end;
|
||||||
|
procedure TAPPLICATIONONMINIMIZE_W(Self: TAPPLICATION; T: TNOTIFYEVENT); begin Self.ONMINIMIZE := T; end;
|
||||||
|
|
||||||
|
procedure TAPPLICATIONONRESTORE_R(Self: TAPPLICATION; var T: TNOTIFYEVENT); begin T := Self.ONRESTORE; end;
|
||||||
|
procedure TAPPLICATIONONRESTORE_W(Self: TAPPLICATION; T: TNOTIFYEVENT); begin Self.ONRESTORE := T; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegisterTAPPLICATION(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TAPPLICATION) do
|
||||||
|
begin
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TAPPLICATION.MINIMIZE, 'MINIMIZE');
|
||||||
|
RegisterMethod(@TAPPLICATION.RESTORE, 'RESTORE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONACTIVE_R, nil, 'ACTIVE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONONACTIVATE_R, @TAPPLICATIONONACTIVATE_W, 'ONACTIVATE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONONDEACTIVATE_R, @TAPPLICATIONONDEACTIVATE_W, 'ONDEACTIVATE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONONMINIMIZE_R, @TAPPLICATIONONMINIMIZE_W, 'ONMINIMIZE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONONRESTORE_R, @TAPPLICATIONONRESTORE_W, 'ONRESTORE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONDIALOGHANDLE_R, @TAPPLICATIONDIALOGHANDLE_W, 'DIALOGHANDLE');
|
||||||
|
RegisterMethod(@TAPPLICATION.CREATEHANDLE, 'CREATEHANDLE');
|
||||||
|
RegisterMethod(@TAPPLICATION.NORMALIZETOPMOSTS, 'NORMALIZETOPMOSTS');
|
||||||
|
RegisterMethod(@TAPPLICATION.RESTORETOPMOSTS, 'RESTORETOPMOSTS');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONHANDLE_R, @TAPPLICATIONHANDLE_W, 'HANDLE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONUPDATEFORMATSETTINGS_R, @TAPPLICATIONUPDATEFORMATSETTINGS_W, 'UPDATEFORMATSETTINGS');
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TAPPLICATION.BRINGTOFRONT, 'BRINGTOFRONT');
|
||||||
|
RegisterMethod(@TAPPLICATION.MESSAGEBOX, 'MESSAGEBOX');
|
||||||
|
RegisterMethod(@TAPPLICATION.PROCESSMESSAGES, 'PROCESSMESSAGES');
|
||||||
|
RegisterMethod(@TAPPLICATION.TERMINATE, 'TERMINATE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONEXENAME_R, nil, 'EXENAME');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONHINT_R, @TAPPLICATIONHINT_W, 'HINT');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONMAINFORM_R, nil, 'MAINFORM');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONSHOWHINT_R, @TAPPLICATIONSHOWHINT_W, 'SHOWHINT');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONSHOWMAINFORM_R, @TAPPLICATIONSHOWMAINFORM_W, 'SHOWMAINFORM');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONTERMINATED_R, nil, 'TERMINATED');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONTITLE_R, @TAPPLICATIONTITLE_W, 'TITLE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONONIDLE_R, @TAPPLICATIONONIDLE_W, 'ONIDLE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONONHINT_R, @TAPPLICATIONONHINT_W, 'ONHINT');
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod(@TAPPLICATION.CONTROLDESTROYED, 'CONTROLDESTROYED');
|
||||||
|
RegisterMethod(@TAPPLICATION.CANCELHINT, 'CANCELHINT');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TAPPLICATION.HELPCOMMAND, 'HELPCOMMAND');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TAPPLICATION.HELPCONTEXT, 'HELPCONTEXT');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TAPPLICATION.HELPJUMP, 'HELPJUMP');
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
// RegisterMethod(@TAPPLICATION.HANDLEEXCEPTION, 'HANDLEEXCEPTION');
|
||||||
|
// RegisterMethod(@TAPPLICATION.HOOKMAINWINDOW, 'HOOKMAINWINDOW');
|
||||||
|
// RegisterMethod(@TAPPLICATION.UNHOOKMAINWINDOW, 'UNHOOKMAINWINDOW');
|
||||||
|
|
||||||
|
RegisterMethod(@TAPPLICATION.HANDLEMESSAGE, 'HANDLEMESSAGE');
|
||||||
|
RegisterMethod(@TAPPLICATION.HIDEHINT, 'HIDEHINT');
|
||||||
|
RegisterMethod(@TAPPLICATION.HINTMOUSEMESSAGE, 'HINTMOUSEMESSAGE');
|
||||||
|
RegisterMethod(@TAPPLICATION.INITIALIZE, 'INITIALIZE');
|
||||||
|
RegisterMethod(@TAPPLICATION.RUN, 'RUN');
|
||||||
|
// RegisterMethod(@TAPPLICATION.SHOWEXCEPTION, 'SHOWEXCEPTION');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONHELPFILE_R, @TAPPLICATIONHELPFILE_W, 'HELPFILE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONHINTCOLOR_R, @TAPPLICATIONHINTCOLOR_W, 'HINTCOLOR');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONHINTPAUSE_R, @TAPPLICATIONHINTPAUSE_W, 'HINTPAUSE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONHINTSHORTPAUSE_R, @TAPPLICATIONHINTSHORTPAUSE_W, 'HINTSHORTPAUSE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONHINTHIDEPAUSE_R, @TAPPLICATIONHINTHIDEPAUSE_W, 'HINTHIDEPAUSE');
|
||||||
|
RegisterPropertyHelper(@TAPPLICATIONONHELP_R, @TAPPLICATIONONHELP_W, 'ONHELP');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegister_Forms(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTCONTROLSCROLLBAR(cl);
|
||||||
|
RIRegisterTSCROLLBOX(cl);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFNDEF FPC} RIRegisterTScrollingWinControl(cl);{$ENDIF}
|
||||||
|
RIRegisterTForm(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTApplication(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
// FPC changes by Boguslaw brandys (brandys at o2 _dot_ pl)
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
218
Units/PascalScript/uPSR_graphics.pas
Normal file
218
Units/PascalScript/uPSR_graphics.pas
Normal file
@ -0,0 +1,218 @@
|
|||||||
|
|
||||||
|
unit uPSR_graphics;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTGRAPHICSOBJECT(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTFont(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTPEN(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTBRUSH(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCanvas(cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTGraphic(CL: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTBitmap(CL: TPSRuntimeClassImporter; Streams: Boolean);
|
||||||
|
|
||||||
|
procedure RIRegister_Graphics(Cl: TPSRuntimeClassImporter; Streams: Boolean);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
uses
|
||||||
|
Classes{$IFDEF CLX}, QGraphics{$ELSE}, Windows, Graphics{$ENDIF};
|
||||||
|
{$ELSE}
|
||||||
|
uses
|
||||||
|
Classes, Graphics,LCLType;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure TFontHandleR(Self: TFont; var T: Longint); begin T := Self.Handle; end;
|
||||||
|
procedure TFontHandleW(Self: TFont; T: Longint); begin Self.Handle := T; end;
|
||||||
|
{$ENDIF}
|
||||||
|
procedure TFontPixelsPerInchR(Self: TFont; var T: Longint); begin T := Self.PixelsPerInch; end;
|
||||||
|
procedure TFontPixelsPerInchW(Self: TFont; T: Longint); begin {$IFNDEF FPC} Self.PixelsPerInch := T;{$ENDIF} end;
|
||||||
|
procedure TFontStyleR(Self: TFont; var T: TFontStyles); begin T := Self.Style; end;
|
||||||
|
procedure TFontStyleW(Self: TFont; T: TFontStyles); begin Self.Style:= T; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTFont(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TFont) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TFont.Create, 'CREATE');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterPropertyHelper(@TFontHandleR, @TFontHandleW, 'HANDLE');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterPropertyHelper(@TFontPixelsPerInchR, @TFontPixelsPerInchW, 'PIXELSPERINCH');
|
||||||
|
RegisterPropertyHelper(@TFontStyleR, @TFontStyleW, 'STYLE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure TCanvasHandleR(Self: TCanvas; var T: Longint); begin T := Self.Handle; end;
|
||||||
|
procedure TCanvasHandleW(Self: TCanvas; T: Longint); begin Self.Handle:= T; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TCanvasPixelsR(Self: TCanvas; var T: Longint; X,Y: Longint); begin T := Self.Pixels[X,Y]; end;
|
||||||
|
procedure TCanvasPixelsW(Self: TCanvas; T, X, Y: Longint); begin Self.Pixels[X,Y]:= T; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTCanvas(cl: TPSRuntimeClassImporter); // requires TPersistent
|
||||||
|
begin
|
||||||
|
with Cl.Add(TCanvas) do
|
||||||
|
begin
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TCanvas.Arc, 'ARC');
|
||||||
|
RegisterMethod(@TCanvas.Chord, 'CHORD');
|
||||||
|
RegisterMethod(@TCanvas.Rectangle, 'RECTANGLE');
|
||||||
|
RegisterMethod(@TCanvas.RoundRect, 'ROUNDRECT');
|
||||||
|
RegisterMethod(@TCanvas.Ellipse, 'ELLIPSE');
|
||||||
|
RegisterMethod(@TCanvas.FillRect, 'FILLRECT');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TCanvas.Draw, 'DRAW');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod(@TCanvas.FloodFill, 'FLOODFILL');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TCanvas.Lineto, 'LINETO');
|
||||||
|
RegisterMethod(@TCanvas.Moveto, 'MOVETO');
|
||||||
|
RegisterMethod(@TCanvas.Pie, 'PIE');
|
||||||
|
RegisterMethod(@TCanvas.Refresh, 'REFRESH');
|
||||||
|
RegisterMethod(@TCanvas.TextHeight, 'TEXTHEIGHT');
|
||||||
|
RegisterMethod(@TCanvas.TextOut, 'TEXTOUT');
|
||||||
|
RegisterMethod(@TCanvas.TextWidth, 'TEXTWIDTH');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterPropertyHelper(@TCanvasHandleR, @TCanvasHandleW, 'HANDLE');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterPropertyHelper(@TCanvasPixelsR, @TCanvasPixelsW, 'PIXELS');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TGRAPHICSOBJECTONCHANGE_W(Self: TGraphicsObject; T: TNotifyEvent); begin Self.OnChange := t; end;
|
||||||
|
procedure TGRAPHICSOBJECTONCHANGE_R(Self: TGraphicsObject; var T: TNotifyEvent); begin T :=Self.OnChange; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTGRAPHICSOBJECT(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TGRAPHICSOBJECT) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TGRAPHICSOBJECTONCHANGE_R, @TGRAPHICSOBJECTONCHANGE_W, 'ONCHANGE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTPEN(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TPEN) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TPEN.CREATE, 'CREATE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTBRUSH(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TBRUSH) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TBRUSH.CREATE, 'CREATE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TGraphicOnChange_W(Self: TGraphic; const T: TNotifyEvent); begin Self.OnChange := T; end;
|
||||||
|
procedure TGraphicOnChange_R(Self: TGraphic; var T: TNotifyEvent); begin T := Self.OnChange; end;
|
||||||
|
procedure TGraphicWidth_W(Self: TGraphic; const T: Integer); begin Self.Width := T; end;
|
||||||
|
procedure TGraphicWidth_R(Self: TGraphic; var T: Integer); begin T := Self.Width; end;
|
||||||
|
procedure TGraphicModified_W(Self: TGraphic; const T: Boolean); begin Self.Modified := T; end;
|
||||||
|
procedure TGraphicModified_R(Self: TGraphic; var T: Boolean); begin T := Self.Modified; end;
|
||||||
|
procedure TGraphicHeight_W(Self: TGraphic; const T: Integer); begin Self.Height := T; end;
|
||||||
|
procedure TGraphicHeight_R(Self: TGraphic; var T: Integer); begin T := Self.Height; end;
|
||||||
|
procedure TGraphicEmpty_R(Self: TGraphic; var T: Boolean); begin T := Self.Empty; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTGraphic(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with CL.Add(TGraphic) do
|
||||||
|
begin
|
||||||
|
RegisterVirtualConstructor(@TGraphic.Create, 'Create');
|
||||||
|
RegisterVirtualMethod(@TGraphic.LoadFromFile, 'LoadFromFile');
|
||||||
|
RegisterVirtualMethod(@TGraphic.SaveToFile, 'SaveToFile');
|
||||||
|
RegisterPropertyHelper(@TGraphicEmpty_R,nil,'Empty');
|
||||||
|
RegisterPropertyHelper(@TGraphicHeight_R,@TGraphicHeight_W,'Height');
|
||||||
|
RegisterPropertyHelper(@TGraphicWidth_R,@TGraphicWidth_W,'Width');
|
||||||
|
RegisterPropertyHelper(@TGraphicOnChange_R,@TGraphicOnChange_W,'OnChange');
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterPropertyHelper(@TGraphicModified_R,@TGraphicModified_W,'Modified');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBitmapTransparentColor_R(Self: TBitmap; var T: TColor); begin T := Self.TransparentColor; end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TBitmapIgnorePalette_W(Self: TBitmap; const T: Boolean); begin Self.IgnorePalette := T; end;
|
||||||
|
procedure TBitmapIgnorePalette_R(Self: TBitmap; var T: Boolean); begin T := Self.IgnorePalette; end;
|
||||||
|
{$ENDIF}
|
||||||
|
procedure TBitmapPalette_W(Self: TBitmap; const T: HPALETTE); begin Self.Palette := T; end;
|
||||||
|
procedure TBitmapPalette_R(Self: TBitmap; var T: HPALETTE); begin T := Self.Palette; end;
|
||||||
|
{$ENDIF}
|
||||||
|
procedure TBitmapMonochrome_W(Self: TBitmap; const T: Boolean); begin Self.Monochrome := T; end;
|
||||||
|
procedure TBitmapMonochrome_R(Self: TBitmap; var T: Boolean); begin T := Self.Monochrome; end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure TBitmapHandle_W(Self: TBitmap; const T: HBITMAP); begin Self.Handle := T; end;
|
||||||
|
procedure TBitmapHandle_R(Self: TBitmap; var T: HBITMAP); begin T := Self.Handle; end;
|
||||||
|
{$ENDIF}
|
||||||
|
procedure TBitmapCanvas_R(Self: TBitmap; var T: TCanvas); begin T := Self.Canvas; end;
|
||||||
|
|
||||||
|
procedure RIRegisterTBitmap(CL: TPSRuntimeClassImporter; Streams: Boolean);
|
||||||
|
begin
|
||||||
|
with CL.Add(TBitmap) do
|
||||||
|
begin
|
||||||
|
if Streams then begin
|
||||||
|
RegisterMethod(@TBitmap.LoadFromStream, 'LoadFromStream');
|
||||||
|
RegisterMethod(@TBitmap.SaveToStream, 'SaveToStream');
|
||||||
|
end;
|
||||||
|
RegisterPropertyHelper(@TBitmapCanvas_R,nil,'Canvas');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterPropertyHelper(@TBitmapHandle_R,@TBitmapHandle_W,'Handle');
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TBitmap.Dormant, 'Dormant');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TBitmap.FreeImage, 'FreeImage');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod(@TBitmap.LoadFromClipboardFormat, 'LoadFromClipboardFormat');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TBitmap.LoadFromResourceName, 'LoadFromResourceName');
|
||||||
|
RegisterMethod(@TBitmap.LoadFromResourceID, 'LoadFromResourceID');
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterMethod(@TBitmap.ReleaseHandle, 'ReleaseHandle');
|
||||||
|
RegisterMethod(@TBitmap.ReleasePalette, 'ReleasePalette');
|
||||||
|
RegisterMethod(@TBitmap.SaveToClipboardFormat, 'SaveToClipboardFormat');
|
||||||
|
RegisterPropertyHelper(@TBitmapMonochrome_R,@TBitmapMonochrome_W,'Monochrome');
|
||||||
|
RegisterPropertyHelper(@TBitmapPalette_R,@TBitmapPalette_W,'Palette');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterPropertyHelper(@TBitmapIgnorePalette_R,@TBitmapIgnorePalette_W,'IgnorePalette');
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterPropertyHelper(@TBitmapTransparentColor_R,nil,'TransparentColor');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegister_Graphics(Cl: TPSRuntimeClassImporter; Streams: Boolean);
|
||||||
|
begin
|
||||||
|
RIRegisterTGRAPHICSOBJECT(cl);
|
||||||
|
RIRegisterTFont(Cl);
|
||||||
|
RIRegisterTCanvas(cl);
|
||||||
|
RIRegisterTPEN(cl);
|
||||||
|
RIRegisterTBRUSH(cl);
|
||||||
|
RIRegisterTGraphic(CL);
|
||||||
|
RIRegisterTBitmap(CL, Streams);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
460
Units/PascalScript/uPSR_menus.pas
Normal file
460
Units/PascalScript/uPSR_menus.pas
Normal file
@ -0,0 +1,460 @@
|
|||||||
|
|
||||||
|
Unit uPSR_menus;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
Interface
|
||||||
|
Uses uPSRuntime;
|
||||||
|
|
||||||
|
procedure RIRegister_Menus_Routines(S: TPSExec);
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure RIRegisterTMENUITEMSTACK(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTPOPUPLIST(Cl: TPSRuntimeClassImporter);
|
||||||
|
{$ENDIF}
|
||||||
|
procedure RIRegisterTPOPUPMENU(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTMAINMENU(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTMENU(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTMENUITEM(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegister_Menus(CL: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
Uses
|
||||||
|
Libc, SysUtils, Classes, QControls, QMenus, QGraphics;
|
||||||
|
{$ELSE}
|
||||||
|
Uses
|
||||||
|
Libc, SysUtils, Classes, Controls, Menus, Graphics, LCLType, ImgList;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ELSE}
|
||||||
|
Uses {$IFNDEF FPC}WINDOWS,{$ELSE} LCLType,{$ENDIF} SYSUTILS, CLASSES, CONTNRS, MESSAGES, GRAPHICS, IMGLIST, ACTNLIST, Menus;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TPOPUPLISTWINDOW_R(Self: TPOPUPLIST; var T: HWND);
|
||||||
|
begin T := Self.WINDOW; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TPOPUPMENUONPOPUP_W(Self: TPOPUPMENU; const T: TNOTIFYEVENT);
|
||||||
|
begin Self.ONPOPUP := T; end;
|
||||||
|
|
||||||
|
procedure TPOPUPMENUONPOPUP_R(Self: TPOPUPMENU; var T: TNOTIFYEVENT);
|
||||||
|
begin T := Self.ONPOPUP; end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TPOPUPMENUTRACKBUTTON_W(Self: TPOPUPMENU; const T: TTRACKBUTTON);
|
||||||
|
begin Self.TRACKBUTTON := T; end;
|
||||||
|
|
||||||
|
procedure TPOPUPMENUTRACKBUTTON_R(Self: TPOPUPMENU; var T: TTRACKBUTTON);
|
||||||
|
begin T := Self.TRACKBUTTON; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TPOPUPMENUMENUANIMATION_W(Self: TPOPUPMENU; const T: TMENUANIMATION);
|
||||||
|
begin Self.MENUANIMATION := T; end;
|
||||||
|
|
||||||
|
procedure TPOPUPMENUMENUANIMATION_R(Self: TPOPUPMENU; var T: TMENUANIMATION);
|
||||||
|
begin T := Self.MENUANIMATION; end;
|
||||||
|
|
||||||
|
procedure TPOPUPMENUHELPCONTEXT_W(Self: TPOPUPMENU; const T: THELPCONTEXT);
|
||||||
|
begin Self.HELPCONTEXT := T; end;
|
||||||
|
|
||||||
|
procedure TPOPUPMENUHELPCONTEXT_R(Self: TPOPUPMENU; var T: THELPCONTEXT);
|
||||||
|
begin T := Self.HELPCONTEXT; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TPOPUPMENUAUTOPOPUP_W(Self: TPOPUPMENU; const T: BOOLEAN);
|
||||||
|
begin Self.AUTOPOPUP := T; end;
|
||||||
|
|
||||||
|
procedure TPOPUPMENUAUTOPOPUP_R(Self: TPOPUPMENU; var T: BOOLEAN);
|
||||||
|
begin T := Self.AUTOPOPUP; end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TPOPUPMENUALIGNMENT_W(Self: TPOPUPMENU; const T: TPOPUPALIGNMENT);
|
||||||
|
begin Self.ALIGNMENT := T; end;
|
||||||
|
|
||||||
|
procedure TPOPUPMENUALIGNMENT_R(Self: TPOPUPMENU; var T: TPOPUPALIGNMENT);
|
||||||
|
begin T := Self.ALIGNMENT; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TPOPUPMENUPOPUPCOMPONENT_W(Self: TPOPUPMENU; const T: TCOMPONENT);
|
||||||
|
begin Self.POPUPCOMPONENT := T; end;
|
||||||
|
|
||||||
|
procedure TPOPUPMENUPOPUPCOMPONENT_R(Self: TPOPUPMENU; var T: TCOMPONENT);
|
||||||
|
begin T := Self.POPUPCOMPONENT; end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TMAINMENUAUTOMERGE_W(Self: TMAINMENU; const T: BOOLEAN);
|
||||||
|
begin Self.AUTOMERGE := T; end;
|
||||||
|
|
||||||
|
procedure TMAINMENUAUTOMERGE_R(Self: TMAINMENU; var T: BOOLEAN);
|
||||||
|
begin T := Self.AUTOMERGE; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TMENUITEMS_R(Self: TMENU; var T: TMENUITEM);
|
||||||
|
begin T := Self.ITEMS; end;
|
||||||
|
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TMENUWINDOWHANDLE_W(Self: TMENU; const T: HWND);
|
||||||
|
begin Self.WINDOWHANDLE := T; end;
|
||||||
|
|
||||||
|
procedure TMENUWINDOWHANDLE_R(Self: TMENU; var T: HWND);
|
||||||
|
begin T := Self.WINDOWHANDLE; end;
|
||||||
|
|
||||||
|
procedure TMENUPARENTBIDIMODE_W(Self: TMENU; const T: BOOLEAN);
|
||||||
|
begin Self.PARENTBIDIMODE := T; end;
|
||||||
|
|
||||||
|
procedure TMENUPARENTBIDIMODE_R(Self: TMENU; var T: BOOLEAN);
|
||||||
|
begin T := Self.PARENTBIDIMODE; end;
|
||||||
|
|
||||||
|
procedure TMENUOWNERDRAW_W(Self: TMENU; const T: BOOLEAN);
|
||||||
|
begin Self.OWNERDRAW := T; end;
|
||||||
|
|
||||||
|
procedure TMENUOWNERDRAW_R(Self: TMENU; var T: BOOLEAN);
|
||||||
|
begin T := Self.OWNERDRAW; end;
|
||||||
|
|
||||||
|
procedure TMENUBIDIMODE_W(Self: TMENU; const T: TBIDIMODE);
|
||||||
|
begin Self.BIDIMODE := T; end;
|
||||||
|
|
||||||
|
procedure TMENUBIDIMODE_R(Self: TMENU; var T: TBIDIMODE);
|
||||||
|
begin T := Self.BIDIMODE; end;
|
||||||
|
|
||||||
|
procedure TMENUAUTOLINEREDUCTION_W(Self: TMENU; const T: TMENUAUTOFLAG);
|
||||||
|
begin Self.AUTOLINEREDUCTION := T; end;
|
||||||
|
|
||||||
|
procedure TMENUAUTOLINEREDUCTION_R(Self: TMENU; var T: TMENUAUTOFLAG);
|
||||||
|
begin T := Self.AUTOLINEREDUCTION; end;
|
||||||
|
|
||||||
|
procedure TMENUAUTOHOTKEYS_W(Self: TMENU; const T: TMENUAUTOFLAG);
|
||||||
|
begin Self.AUTOHOTKEYS := T; end;
|
||||||
|
|
||||||
|
procedure TMENUAUTOHOTKEYS_R(Self: TMENU; var T: TMENUAUTOFLAG);
|
||||||
|
begin T := Self.AUTOHOTKEYS; end;
|
||||||
|
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMENUHANDLE_R(Self: TMENU; var T: HMENU);
|
||||||
|
begin T := Self.HANDLE; end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMENUIMAGES_W(Self: TMENU; const T: TCUSTOMIMAGELIST);
|
||||||
|
begin Self.IMAGES := T; end;
|
||||||
|
|
||||||
|
procedure TMENUIMAGES_R(Self: TMENU; var T: TCUSTOMIMAGELIST);
|
||||||
|
begin T := Self.IMAGES; end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TMENUITEMONMEASUREITEM_W(Self: TMENUITEM; const T: TMENUMEASUREITEMEVENT);
|
||||||
|
begin Self.ONMEASUREITEM := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMONMEASUREITEM_R(Self: TMENUITEM; var T: TMENUMEASUREITEMEVENT);
|
||||||
|
begin T := Self.ONMEASUREITEM; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMONADVANCEDDRAWITEM_W(Self: TMENUITEM; const T: TADVANCEDMENUDRAWITEMEVENT);
|
||||||
|
begin Self.ONADVANCEDDRAWITEM := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMONADVANCEDDRAWITEM_R(Self: TMENUITEM; var T: TADVANCEDMENUDRAWITEMEVENT);
|
||||||
|
begin T := Self.ONADVANCEDDRAWITEM; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMONDRAWITEM_W(Self: TMENUITEM; const T: TMENUDRAWITEMEVENT);
|
||||||
|
begin Self.ONDRAWITEM := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMONDRAWITEM_R(Self: TMENUITEM; var T: TMENUDRAWITEMEVENT);
|
||||||
|
begin T := Self.ONDRAWITEM; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TMENUITEMONCLICK_W(Self: TMENUITEM; const T: TNOTIFYEVENT);
|
||||||
|
begin Self.ONCLICK := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMONCLICK_R(Self: TMENUITEM; var T: TNOTIFYEVENT);
|
||||||
|
begin T := Self.ONCLICK; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMVISIBLE_W(Self: TMENUITEM; const T: BOOLEAN);
|
||||||
|
begin Self.VISIBLE := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMVISIBLE_R(Self: TMENUITEM; var T: BOOLEAN);
|
||||||
|
begin T := Self.VISIBLE; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMSHORTCUT_W(Self: TMENUITEM; const T: TSHORTCUT);
|
||||||
|
begin Self.SHORTCUT := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMSHORTCUT_R(Self: TMENUITEM; var T: TSHORTCUT);
|
||||||
|
begin T := Self.SHORTCUT; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMRADIOITEM_W(Self: TMENUITEM; const T: BOOLEAN);
|
||||||
|
begin Self.RADIOITEM := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMRADIOITEM_R(Self: TMENUITEM; var T: BOOLEAN);
|
||||||
|
begin T := Self.RADIOITEM; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMIMAGEINDEX_W(Self: TMENUITEM; const T: TIMAGEINDEX);
|
||||||
|
begin Self.IMAGEINDEX := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMIMAGEINDEX_R(Self: TMENUITEM; var T: TIMAGEINDEX);
|
||||||
|
begin T := Self.IMAGEINDEX; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMHINT_W(Self: TMENUITEM; const T: STRING);
|
||||||
|
begin Self.HINT := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMHINT_R(Self: TMENUITEM; var T: STRING);
|
||||||
|
begin T := Self.HINT; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMHELPCONTEXT_W(Self: TMENUITEM; const T: THELPCONTEXT);
|
||||||
|
begin Self.HELPCONTEXT := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMHELPCONTEXT_R(Self: TMENUITEM; var T: THELPCONTEXT);
|
||||||
|
begin T := Self.HELPCONTEXT; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMGROUPINDEX_W(Self: TMENUITEM; const T: BYTE);
|
||||||
|
begin Self.GROUPINDEX := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMGROUPINDEX_R(Self: TMENUITEM; var T: BYTE);
|
||||||
|
begin T := Self.GROUPINDEX; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMENABLED_W(Self: TMENUITEM; const T: BOOLEAN);
|
||||||
|
begin Self.ENABLED := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMENABLED_R(Self: TMENUITEM; var T: BOOLEAN);
|
||||||
|
begin T := Self.ENABLED; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMDEFAULT_W(Self: TMENUITEM; const T: BOOLEAN);
|
||||||
|
begin Self.DEFAULT := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMDEFAULT_R(Self: TMENUITEM; var T: BOOLEAN);
|
||||||
|
begin T := Self.DEFAULT; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMSUBMENUIMAGES_W(Self: TMENUITEM; const T: TCUSTOMIMAGELIST);
|
||||||
|
begin Self.SUBMENUIMAGES := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMSUBMENUIMAGES_R(Self: TMENUITEM; var T: TCUSTOMIMAGELIST);
|
||||||
|
begin T := Self.SUBMENUIMAGES; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMCHECKED_W(Self: TMENUITEM; const T: BOOLEAN);
|
||||||
|
begin Self.CHECKED := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMCHECKED_R(Self: TMENUITEM; var T: BOOLEAN);
|
||||||
|
begin T := Self.CHECKED; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMCAPTION_W(Self: TMENUITEM; const T: STRING);
|
||||||
|
begin Self.CAPTION := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMCAPTION_R(Self: TMENUITEM; var T: STRING);
|
||||||
|
begin T := Self.CAPTION; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMBITMAP_W(Self: TMENUITEM; const T: TBITMAP);
|
||||||
|
begin Self.BITMAP := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMBITMAP_R(Self: TMENUITEM; var T: TBITMAP);
|
||||||
|
begin T := Self.BITMAP; end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure TMENUITEMAUTOLINEREDUCTION_W(Self: TMENUITEM; const T: TMENUITEMAUTOFLAG);
|
||||||
|
begin Self.AUTOLINEREDUCTION := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMAUTOLINEREDUCTION_R(Self: TMENUITEM; var T: TMENUITEMAUTOFLAG);
|
||||||
|
begin T := Self.AUTOLINEREDUCTION; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMAUTOHOTKEYS_W(Self: TMENUITEM; const T: TMENUITEMAUTOFLAG);
|
||||||
|
begin Self.AUTOHOTKEYS := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMAUTOHOTKEYS_R(Self: TMENUITEM; var T: TMENUITEMAUTOFLAG);
|
||||||
|
begin T := Self.AUTOHOTKEYS; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TMENUITEMACTION_W(Self: TMENUITEM; const T: TBASICACTION);
|
||||||
|
begin Self.ACTION := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMACTION_R(Self: TMENUITEM; var T: TBASICACTION);
|
||||||
|
begin T := Self.ACTION; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMPARENT_R(Self: TMENUITEM; var T: TMENUITEM);
|
||||||
|
begin T := Self.PARENT; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMMENUINDEX_W(Self: TMENUITEM; const T: INTEGER);
|
||||||
|
begin Self.MENUINDEX := T; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMMENUINDEX_R(Self: TMENUITEM; var T: INTEGER);
|
||||||
|
begin T := Self.MENUINDEX; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMITEMS_R(Self: TMENUITEM; var T: TMENUITEM; const t1: INTEGER);
|
||||||
|
begin T := Self.ITEMS[t1]; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMCOUNT_R(Self: TMENUITEM; var T: INTEGER);
|
||||||
|
begin T := Self.COUNT; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMHANDLE_R(Self: TMENUITEM; var T: HMENU);
|
||||||
|
begin T := Self.HANDLE; end;
|
||||||
|
|
||||||
|
procedure TMENUITEMCOMMAND_R(Self: TMENUITEM; var T: WORD);
|
||||||
|
begin T := Self.COMMAND; end;
|
||||||
|
|
||||||
|
procedure RIRegister_Menus_Routines(S: TPSExec);
|
||||||
|
begin
|
||||||
|
S.RegisterDelphiFunction(@SHORTCUT, 'SHORTCUT', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@SHORTCUTTOKEY, 'SHORTCUTTOKEY', cdRegister);
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
S.RegisterDelphiFunction(@SHORTCUTTOTEXT, 'SHORTCUTTOTEXT', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@TEXTTOSHORTCUT, 'TEXTTOSHORTCUT', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@NEWMENU, 'NEWMENU', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@NEWPOPUPMENU, 'NEWPOPUPMENU', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@NEWSUBMENU, 'NEWSUBMENU', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@NEWITEM, 'NEWITEM', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@NEWLINE, 'NEWLINE', cdRegister);
|
||||||
|
S.RegisterDelphiFunction(@DRAWMENUITEM, 'DRAWMENUITEM', cdRegister);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
procedure RIRegisterTMENUITEMSTACK(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TMENUITEMSTACK) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TMENUITEMSTACK.CLEARITEM, 'CLEARITEM');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTPOPUPLIST(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TPOPUPLIST) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TPOPUPLISTWINDOW_R,nil,'WINDOW');
|
||||||
|
RegisterMethod(@TPOPUPLIST.ADD, 'ADD');
|
||||||
|
RegisterMethod(@TPOPUPLIST.REMOVE, 'REMOVE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTPOPUPMENU(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TPOPUPMENU) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TPOPUPMENU.CREATE, 'CREATE');
|
||||||
|
RegisterVirtualMethod(@TPOPUPMENU.POPUP, 'POPUP');
|
||||||
|
RegisterPropertyHelper(@TPOPUPMENUPOPUPCOMPONENT_R,@TPOPUPMENUPOPUPCOMPONENT_W,'POPUPCOMPONENT');
|
||||||
|
RegisterEventPropertyHelper(@TPOPUPMENUONPOPUP_R,@TPOPUPMENUONPOPUP_W,'ONPOPUP');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterPropertyHelper(@TPOPUPMENUALIGNMENT_R,@TPOPUPMENUALIGNMENT_W,'ALIGNMENT');
|
||||||
|
RegisterPropertyHelper(@TPOPUPMENUAUTOPOPUP_R,@TPOPUPMENUAUTOPOPUP_W,'AUTOPOPUP');
|
||||||
|
RegisterPropertyHelper(@TPOPUPMENUHELPCONTEXT_R,@TPOPUPMENUHELPCONTEXT_W,'HELPCONTEXT');
|
||||||
|
RegisterPropertyHelper(@TPOPUPMENUMENUANIMATION_R,@TPOPUPMENUMENUANIMATION_W,'MENUANIMATION');
|
||||||
|
RegisterPropertyHelper(@TPOPUPMENUTRACKBUTTON_R,@TPOPUPMENUTRACKBUTTON_W,'TRACKBUTTON');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTMAINMENU(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TMAINMENU) do
|
||||||
|
begin
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TMAINMENU.MERGE, 'MERGE');
|
||||||
|
RegisterMethod(@TMAINMENU.UNMERGE, 'UNMERGE');
|
||||||
|
RegisterMethod(@TMAINMENU.POPULATEOLE2MENU, 'POPULATEOLE2MENU');
|
||||||
|
RegisterMethod(@TMAINMENU.GETOLE2ACCELERATORTABLE, 'GETOLE2ACCELERATORTABLE');
|
||||||
|
RegisterMethod(@TMAINMENU.SETOLE2MENUHANDLE, 'SETOLE2MENUHANDLE');
|
||||||
|
RegisterPropertyHelper(@TMAINMENUAUTOMERGE_R,@TMAINMENUAUTOMERGE_W,'AUTOMERGE');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTMENU(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TMENU) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TMENU.CREATE, 'CREATE');
|
||||||
|
RegisterMethod(@TMENU.DISPATCHCOMMAND, 'DISPATCHCOMMAND');
|
||||||
|
RegisterMethod(@TMENU.FINDITEM, 'FINDITEM');
|
||||||
|
RegisterPropertyHelper(@TMENUIMAGES_R,@TMENUIMAGES_W,'IMAGES');
|
||||||
|
RegisterMethod(@TMENU.ISRIGHTTOLEFT, 'ISRIGHTTOLEFT');
|
||||||
|
RegisterPropertyHelper(@TMENUHANDLE_R,nil,'HANDLE');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMS_R,nil,'ITEMS');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TMENU.DISPATCHPOPUP, 'DISPATCHPOPUP');
|
||||||
|
RegisterMethod(@TMENU.PARENTBIDIMODECHANGED, 'PARENTBIDIMODECHANGED');
|
||||||
|
RegisterMethod(@TMENU.PROCESSMENUCHAR, 'PROCESSMENUCHAR');
|
||||||
|
RegisterPropertyHelper(@TMENUAUTOHOTKEYS_R,@TMENUAUTOHOTKEYS_W,'AUTOHOTKEYS');
|
||||||
|
RegisterPropertyHelper(@TMENUAUTOLINEREDUCTION_R,@TMENUAUTOLINEREDUCTION_W,'AUTOLINEREDUCTION');
|
||||||
|
RegisterPropertyHelper(@TMENUBIDIMODE_R,@TMENUBIDIMODE_W,'BIDIMODE');
|
||||||
|
RegisterMethod(@TMENU.GETHELPCONTEXT, 'GETHELPCONTEXT');
|
||||||
|
RegisterPropertyHelper(@TMENUOWNERDRAW_R,@TMENUOWNERDRAW_W,'OWNERDRAW');
|
||||||
|
RegisterPropertyHelper(@TMENUPARENTBIDIMODE_R,@TMENUPARENTBIDIMODE_W,'PARENTBIDIMODE');
|
||||||
|
RegisterPropertyHelper(@TMENUWINDOWHANDLE_R,@TMENUWINDOWHANDLE_W,'WINDOWHANDLE');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTMENUITEM(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TMENUITEM) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TMENUITEM.CREATE, 'CREATE');
|
||||||
|
RegisterVirtualMethod(@TMENUITEM.INITIATEACTION, 'INITIATEACTION');
|
||||||
|
RegisterMethod(@TMENUITEM.INSERT, 'INSERT');
|
||||||
|
RegisterMethod(@TMENUITEM.DELETE, 'DELETE');
|
||||||
|
RegisterMethod(@TMENUITEM.CLEAR, 'CLEAR');
|
||||||
|
RegisterVirtualMethod(@TMENUITEM.CLICK, 'CLICK');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TMENUITEM.FIND, 'FIND');
|
||||||
|
RegisterMethod(@TMENUITEM.NEWTOPLINE, 'NEWTOPLINE');
|
||||||
|
RegisterMethod(@TMENUITEM.NEWBOTTOMLINE, 'NEWBOTTOMLINE');
|
||||||
|
RegisterMethod(@TMENUITEM.INSERTNEWLINEBEFORE, 'INSERTNEWLINEBEFORE');
|
||||||
|
RegisterMethod(@TMENUITEM.INSERTNEWLINEAFTER, 'INSERTNEWLINEAFTER');
|
||||||
|
RegisterMethod(@TMENUITEM.RETHINKHOTKEYS, 'RETHINKHOTKEYS');
|
||||||
|
RegisterMethod(@TMENUITEM.RETHINKLINES, 'RETHINKLINES');
|
||||||
|
RegisterMethod(@TMENUITEM.ISLINE, 'ISLINE');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterMethod(@TMENUITEM.INDEXOF, 'INDEXOF');
|
||||||
|
RegisterMethod(@TMENUITEM.GETIMAGELIST, 'GETIMAGELIST');
|
||||||
|
RegisterMethod(@TMENUITEM.GETPARENTCOMPONENT, 'GETPARENTCOMPONENT');
|
||||||
|
RegisterMethod(@TMENUITEM.GETPARENTMENU, 'GETPARENTMENU');
|
||||||
|
RegisterMethod(@TMENUITEM.HASPARENT, 'HASPARENT');
|
||||||
|
RegisterMethod(@TMENUITEM.ADD, 'ADD');
|
||||||
|
RegisterMethod(@TMENUITEM.REMOVE, 'REMOVE');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterPropertyHelper(@TMENUITEMAUTOHOTKEYS_R,@TMENUITEMAUTOHOTKEYS_W,'AUTOHOTKEYS');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMAUTOLINEREDUCTION_R,@TMENUITEMAUTOLINEREDUCTION_W,'AUTOLINEREDUCTION');
|
||||||
|
RegisterEventPropertyHelper(@TMENUITEMONDRAWITEM_R,@TMENUITEMONDRAWITEM_W,'ONDRAWITEM');
|
||||||
|
RegisterEventPropertyHelper(@TMENUITEMONADVANCEDDRAWITEM_R,@TMENUITEMONADVANCEDDRAWITEM_W,'ONADVANCEDDRAWITEM');
|
||||||
|
RegisterEventPropertyHelper(@TMENUITEMONMEASUREITEM_R,@TMENUITEMONMEASUREITEM_W,'ONMEASUREITEM');
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterPropertyHelper(@TMENUITEMCOMMAND_R,nil,'COMMAND');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMHANDLE_R,nil,'HANDLE');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMCOUNT_R,nil,'COUNT');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMITEMS_R,nil,'ITEMS');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMMENUINDEX_R,@TMENUITEMMENUINDEX_W,'MENUINDEX');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMPARENT_R,nil,'PARENT');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMACTION_R,@TMENUITEMACTION_W,'ACTION');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMBITMAP_R,@TMENUITEMBITMAP_W,'BITMAP');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMCAPTION_R,@TMENUITEMCAPTION_W,'CAPTION');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMCHECKED_R,@TMENUITEMCHECKED_W,'CHECKED');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMSUBMENUIMAGES_R,@TMENUITEMSUBMENUIMAGES_W,'SUBMENUIMAGES');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMDEFAULT_R,@TMENUITEMDEFAULT_W,'DEFAULT');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMENABLED_R,@TMENUITEMENABLED_W,'ENABLED');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMGROUPINDEX_R,@TMENUITEMGROUPINDEX_W,'GROUPINDEX');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMHELPCONTEXT_R,@TMENUITEMHELPCONTEXT_W,'HELPCONTEXT');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMHINT_R,@TMENUITEMHINT_W,'HINT');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMIMAGEINDEX_R,@TMENUITEMIMAGEINDEX_W,'IMAGEINDEX');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMRADIOITEM_R,@TMENUITEMRADIOITEM_W,'RADIOITEM');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMSHORTCUT_R,@TMENUITEMSHORTCUT_W,'SHORTCUT');
|
||||||
|
RegisterPropertyHelper(@TMENUITEMVISIBLE_R,@TMENUITEMVISIBLE_W,'VISIBLE');
|
||||||
|
RegisterEventPropertyHelper(@TMENUITEMONCLICK_R,@TMENUITEMONCLICK_W,'ONCLICK');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegister_Menus(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegisterTMENUITEM(Cl);
|
||||||
|
RIRegisterTMENU(Cl);
|
||||||
|
RIRegisterTPOPUPMENU(Cl);
|
||||||
|
RIRegisterTMAINMENU(Cl);
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RIRegisterTPOPUPLIST(Cl);
|
||||||
|
RIRegisterTMENUITEMSTACK(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
85
Units/PascalScript/uPSR_std.pas
Normal file
85
Units/PascalScript/uPSR_std.pas
Normal file
@ -0,0 +1,85 @@
|
|||||||
|
|
||||||
|
unit uPSR_std;
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTObject(CL: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTPersistent(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTComponent(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegister_Std(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
Classes;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTObject(CL: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with cl.Add(TObject) do
|
||||||
|
begin
|
||||||
|
RegisterConstructor(@TObject.Create, 'CREATE');
|
||||||
|
RegisterMethod(@TObject.Free, 'FREE');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTPersistent(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TPersistent) do
|
||||||
|
begin
|
||||||
|
RegisterVirtualMethod(@TPersistent.Assign, 'ASSIGN');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TComponentOwnerR(Self: TComponent; var T: TComponent); begin T := Self.Owner; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TCOMPONENTCOMPONENTS_R(Self: TCOMPONENT; var T: TCOMPONENT; t1: INTEGER); begin T := Self.COMPONENTS[t1]; end;
|
||||||
|
procedure TCOMPONENTCOMPONENTCOUNT_R(Self: TCOMPONENT; var T: INTEGER); begin t := Self.COMPONENTCOUNT; end;
|
||||||
|
procedure TCOMPONENTCOMPONENTINDEX_R(Self: TCOMPONENT; var T: INTEGER); begin t := Self.COMPONENTINDEX; end;
|
||||||
|
procedure TCOMPONENTCOMPONENTINDEX_W(Self: TCOMPONENT; T: INTEGER); begin Self.COMPONENTINDEX := t; end;
|
||||||
|
procedure TCOMPONENTCOMPONENTSTATE_R(Self: TCOMPONENT; var T: TCOMPONENTSTATE); begin t := Self.COMPONENTSTATE; end;
|
||||||
|
procedure TCOMPONENTDESIGNINFO_R(Self: TCOMPONENT; var T: LONGINT); begin t := Self.DESIGNINFO; end;
|
||||||
|
procedure TCOMPONENTDESIGNINFO_W(Self: TCOMPONENT; T: LONGINT); begin Self.DESIGNINFO := t; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTComponent(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TComponent) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TComponent.FindComponent, 'FINDCOMPONENT');
|
||||||
|
RegisterVirtualConstructor(@TComponent.Create, 'CREATE');
|
||||||
|
RegisterPropertyHelper(@TComponentOwnerR, nil, 'OWNER');
|
||||||
|
|
||||||
|
RegisterMethod(@TCOMPONENT.DESTROYCOMPONENTS, 'DESTROYCOMPONENTS');
|
||||||
|
RegisterPropertyHelper(@TCOMPONENTCOMPONENTS_R, nil, 'COMPONENTS');
|
||||||
|
RegisterPropertyHelper(@TCOMPONENTCOMPONENTCOUNT_R, nil, 'COMPONENTCOUNT');
|
||||||
|
RegisterPropertyHelper(@TCOMPONENTCOMPONENTINDEX_R, @TCOMPONENTCOMPONENTINDEX_W, 'COMPONENTINDEX');
|
||||||
|
RegisterPropertyHelper(@TCOMPONENTCOMPONENTSTATE_R, nil, 'COMPONENTSTATE');
|
||||||
|
RegisterPropertyHelper(@TCOMPONENTDESIGNINFO_R, @TCOMPONENTDESIGNINFO_W, 'DESIGNINFO');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegister_Std(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegisterTObject(CL);
|
||||||
|
RIRegisterTPersistent(Cl);
|
||||||
|
RIRegisterTComponent(Cl);
|
||||||
|
end;
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
287
Units/PascalScript/uPSR_stdctrls.pas
Normal file
287
Units/PascalScript/uPSR_stdctrls.pas
Normal file
@ -0,0 +1,287 @@
|
|||||||
|
{ STDCtrls import unit }
|
||||||
|
unit uPSR_stdctrls;
|
||||||
|
|
||||||
|
{$I PascalScript.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
uPSRuntime, uPSUtils;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMGROUPBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTGROUPBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCUSTOMLABEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTLABEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCUSTOMEDIT(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTEDIT(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCUSTOMMEMO(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTMEMO(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCUSTOMCOMBOBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCOMBOBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTBUTTONCONTROL(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTBUTTON(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCUSTOMCHECKBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCHECKBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTRADIOBUTTON(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTCUSTOMLISTBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTLISTBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTSCROLLBAR(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
procedure RIRegister_stdctrls(cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
sysutils, classes{$IFDEF CLX}, QControls, QStdCtrls, QGraphics{$ELSE}, controls, stdctrls, Graphics{$ENDIF}{$IFDEF FPC},buttons{$ENDIF};
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMGROUPBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TCUSTOMGROUPBOX);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTGROUPBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TGROUPBOX);
|
||||||
|
end;
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
procedure TCUSTOMLABELCANVAS_R(Self: TCUSTOMLABEL; var T: TCanvas); begin T := Self.CANVAS; end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMLABEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TCUSTOMLABEL) do
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterPropertyHelper(@TCUSTOMLABELCANVAS_R, nil, 'CANVAS');
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTLABEL(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TLABEL);
|
||||||
|
end;
|
||||||
|
procedure TCUSTOMEDITMODIFIED_R(Self: TCUSTOMEDIT; var T: BOOLEAN); begin T := Self.MODIFIED; end;
|
||||||
|
procedure TCUSTOMEDITMODIFIED_W(Self: TCUSTOMEDIT; T: BOOLEAN); begin Self.MODIFIED := T; end;
|
||||||
|
procedure TCUSTOMEDITSELLENGTH_R(Self: TCUSTOMEDIT; var T: INTEGER); begin T := Self.SELLENGTH; end;
|
||||||
|
procedure TCUSTOMEDITSELLENGTH_W(Self: TCUSTOMEDIT; T: INTEGER); begin Self.SELLENGTH := T; end;
|
||||||
|
procedure TCUSTOMEDITSELSTART_R(Self: TCUSTOMEDIT; var T: INTEGER); begin T := Self.SELSTART; end;
|
||||||
|
procedure TCUSTOMEDITSELSTART_W(Self: TCUSTOMEDIT; T: INTEGER); begin Self.SELSTART := T; end;
|
||||||
|
procedure TCUSTOMEDITSELTEXT_R(Self: TCUSTOMEDIT; var T: STRING); begin T := Self.SELTEXT; end;
|
||||||
|
procedure TCUSTOMEDITSELTEXT_W(Self: TCUSTOMEDIT; T: STRING); begin Self.SELTEXT := T; end;
|
||||||
|
procedure TCUSTOMEDITTEXT_R(Self: TCUSTOMEDIT; var T: string); begin T := Self.TEXT; end;
|
||||||
|
procedure TCUSTOMEDITTEXT_W(Self: TCUSTOMEDIT; T: string); begin Self.TEXT := T; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMEDIT(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TCUSTOMEDIT) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TCUSTOMEDIT.CLEAR, 'CLEAR');
|
||||||
|
RegisterMethod(@TCUSTOMEDIT.CLEARSELECTION, 'CLEARSELECTION');
|
||||||
|
RegisterMethod(@TCUSTOMEDIT.SELECTALL, 'SELECTALL');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMEDITMODIFIED_R, @TCUSTOMEDITMODIFIED_W, 'MODIFIED');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMEDITSELLENGTH_R, @TCUSTOMEDITSELLENGTH_W, 'SELLENGTH');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMEDITSELSTART_R, @TCUSTOMEDITSELSTART_W, 'SELSTART');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMEDITSELTEXT_R, @TCUSTOMEDITSELTEXT_W, 'SELTEXT');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMEDITTEXT_R, @TCUSTOMEDITTEXT_W, 'TEXT');
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod(@TCUSTOMEDIT.COPYTOCLIPBOARD, 'COPYTOCLIPBOARD');
|
||||||
|
RegisterMethod(@TCUSTOMEDIT.CUTTOCLIPBOARD, 'CUTTOCLIPBOARD');
|
||||||
|
RegisterMethod(@TCUSTOMEDIT.PASTEFROMCLIPBOARD, 'PASTEFROMCLIPBOARD');
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
RegisterMethod(@TCUSTOMEDIT.GETSELTEXTBUF, 'GETSELTEXTBUF');
|
||||||
|
RegisterMethod(@TCUSTOMEDIT.SETSELTEXTBUF, 'SETSELTEXTBUF');
|
||||||
|
{$ENDIF}{FPC}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTEDIT(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TEDIT);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TCUSTOMMEMOLINES_R(Self: {$IFDEF CLX}TMemo{$ELSE}TCUSTOMMEMO{$ENDIF}; var T: TSTRINGS); begin T := Self.LINES; end;
|
||||||
|
procedure TCUSTOMMEMOLINES_W(Self: {$IFDEF CLX}TMemo{$ELSE}TCUSTOMMEMO{$ENDIF}; T: TSTRINGS); begin Self.LINES := T; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMMEMO(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TCUSTOMMEMO) do
|
||||||
|
begin
|
||||||
|
{$IFNDEF CLX}
|
||||||
|
RegisterPropertyHelper(@TCUSTOMMEMOLINES_R, @TCUSTOMMEMOLINES_W, 'LINES');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTMEMO(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TMEMO) do
|
||||||
|
begin
|
||||||
|
{$IFDEF CLX}
|
||||||
|
RegisterPropertyHelper(@TCUSTOMMEMOLINES_R, @TCUSTOMMEMOLINES_W, 'LINES');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TCUSTOMCOMBOBOXCANVAS_R(Self: TCUSTOMCOMBOBOX; var T: TCANVAS); begin T := Self.CANVAS; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXDROPPEDDOWN_R(Self: TCUSTOMCOMBOBOX; var T: BOOLEAN); begin T := Self.DROPPEDDOWN; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXDROPPEDDOWN_W(Self: TCUSTOMCOMBOBOX; T: BOOLEAN); begin Self.DROPPEDDOWN := T; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXITEMS_R(Self: TCUSTOMCOMBOBOX; var T: TSTRINGS); begin T := Self.ITEMS; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXITEMS_W(Self: TCUSTOMCOMBOBOX; T: TSTRINGS); begin Self.ITEMS := T; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXITEMINDEX_R(Self: TCUSTOMCOMBOBOX; var T: INTEGER); begin T := Self.ITEMINDEX; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXITEMINDEX_W(Self: TCUSTOMCOMBOBOX; T: INTEGER); begin Self.ITEMINDEX := T; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXSELLENGTH_R(Self: TCUSTOMCOMBOBOX; var T: INTEGER); begin T := Self.SELLENGTH; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXSELLENGTH_W(Self: TCUSTOMCOMBOBOX; T: INTEGER); begin Self.SELLENGTH := T; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXSELSTART_R(Self: TCUSTOMCOMBOBOX; var T: INTEGER); begin T := Self.SELSTART; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXSELSTART_W(Self: TCUSTOMCOMBOBOX; T: INTEGER); begin Self.SELSTART := T; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXSELTEXT_R(Self: TCUSTOMCOMBOBOX; var T: STRING); begin T := Self.SELTEXT; end;
|
||||||
|
procedure TCUSTOMCOMBOBOXSELTEXT_W(Self: TCUSTOMCOMBOBOX; T: STRING); begin Self.SELTEXT := T; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMCOMBOBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TCUSTOMCOMBOBOX) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TCUSTOMCOMBOBOXDROPPEDDOWN_R, @TCUSTOMCOMBOBOXDROPPEDDOWN_W, 'DROPPEDDOWN');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMCOMBOBOXITEMS_R, @TCUSTOMCOMBOBOXITEMS_W, 'ITEMS');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMCOMBOBOXITEMINDEX_R, @TCUSTOMCOMBOBOXITEMINDEX_W, 'ITEMINDEX');
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod(@TCUSTOMCOMBOBOX.CLEAR, 'CLEAR');
|
||||||
|
RegisterMethod(@TCUSTOMCOMBOBOX.SELECTALL, 'SELECTALL');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMCOMBOBOXCANVAS_R, nil, 'CANVAS');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMCOMBOBOXSELLENGTH_R, @TCUSTOMCOMBOBOXSELLENGTH_W, 'SELLENGTH');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMCOMBOBOXSELSTART_R, @TCUSTOMCOMBOBOXSELSTART_W, 'SELSTART');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMCOMBOBOXSELTEXT_R, @TCUSTOMCOMBOBOXSELTEXT_W, 'SELTEXT');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTCOMBOBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TCOMBOBOX);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTBUTTONCONTROL(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TBUTTONCONTROL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTBUTTON(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TBUTTON);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMCHECKBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TCUSTOMCHECKBOX);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTCHECKBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TCHECKBOX);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTRADIOBUTTON(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TRADIOBUTTON);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCUSTOMLISTBOXCANVAS_R(Self: TCUSTOMLISTBOX; var T: TCANVAS); begin T := Self.CANVAS; end;
|
||||||
|
procedure TCUSTOMLISTBOXITEMS_R(Self: TCUSTOMLISTBOX; var T: TSTRINGS); begin T := Self.ITEMS; end;
|
||||||
|
procedure TCUSTOMLISTBOXITEMS_W(Self: TCUSTOMLISTBOX; T: TSTRINGS); begin Self.ITEMS := T; end;
|
||||||
|
procedure TCUSTOMLISTBOXITEMINDEX_R(Self: TCUSTOMLISTBOX; var T: INTEGER); begin T := Self.ITEMINDEX; end;
|
||||||
|
procedure TCUSTOMLISTBOXITEMINDEX_W(Self: TCUSTOMLISTBOX; T: INTEGER); begin Self.ITEMINDEX := T; end;
|
||||||
|
procedure TCUSTOMLISTBOXSELCOUNT_R(Self: TCUSTOMLISTBOX; var T: INTEGER); begin T := Self.SELCOUNT; end;
|
||||||
|
procedure TCUSTOMLISTBOXSELECTED_R(Self: TCUSTOMLISTBOX; var T: BOOLEAN; t1: INTEGER); begin T := Self.SELECTED[t1]; end;
|
||||||
|
procedure TCUSTOMLISTBOXSELECTED_W(Self: TCUSTOMLISTBOX; T: BOOLEAN; t1: INTEGER); begin Self.SELECTED[t1] := T; end;
|
||||||
|
procedure TCUSTOMLISTBOXTOPINDEX_R(Self: TCUSTOMLISTBOX; var T: INTEGER); begin T := Self.TOPINDEX; end;
|
||||||
|
procedure TCUSTOMLISTBOXTOPINDEX_W(Self: TCUSTOMLISTBOX; T: INTEGER); begin Self.TOPINDEX := T; end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTCUSTOMLISTBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TCUSTOMLISTBOX) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TCUSTOMLISTBOXITEMS_R, @TCUSTOMLISTBOXITEMS_W, 'ITEMS');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMLISTBOXITEMINDEX_R, @TCUSTOMLISTBOXITEMINDEX_W, 'ITEMINDEX');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMLISTBOXSELCOUNT_R, nil, 'SELCOUNT');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMLISTBOXSELECTED_R, @TCUSTOMLISTBOXSELECTED_W, 'SELECTED');
|
||||||
|
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RegisterMethod(@TCUSTOMLISTBOX.CLEAR, 'CLEAR');
|
||||||
|
RegisterMethod(@TCUSTOMLISTBOX.ITEMATPOS, 'ITEMATPOS');
|
||||||
|
RegisterMethod(@TCUSTOMLISTBOX.ITEMRECT, 'ITEMRECT');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMLISTBOXCANVAS_R, nil, 'CANVAS');
|
||||||
|
RegisterPropertyHelper(@TCUSTOMLISTBOXTOPINDEX_R, @TCUSTOMLISTBOXTOPINDEX_W, 'TOPINDEX');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTLISTBOX(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
Cl.Add(TLISTBOX);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTSCROLLBAR(Cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TSCROLLBAR) do
|
||||||
|
begin
|
||||||
|
RegisterMethod(@TSCROLLBAR.SETPARAMS, 'SETPARAMS');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegister_stdctrls(cl: TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTCUSTOMGROUPBOX(Cl);
|
||||||
|
RIRegisterTGROUPBOX(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
RIRegisterTCUSTOMLABEL(Cl);
|
||||||
|
RIRegisterTLABEL(Cl);
|
||||||
|
RIRegisterTCUSTOMEDIT(Cl);
|
||||||
|
RIRegisterTEDIT(Cl);
|
||||||
|
RIRegisterTCUSTOMMEMO(Cl);
|
||||||
|
RIRegisterTMEMO(Cl);
|
||||||
|
RIRegisterTCUSTOMCOMBOBOX(Cl);
|
||||||
|
RIRegisterTCOMBOBOX(Cl);
|
||||||
|
RIRegisterTBUTTONCONTROL(Cl);
|
||||||
|
RIRegisterTBUTTON(Cl);
|
||||||
|
RIRegisterTCUSTOMCHECKBOX(Cl);
|
||||||
|
RIRegisterTCHECKBOX(Cl);
|
||||||
|
RIRegisterTRADIOBUTTON(Cl);
|
||||||
|
RIRegisterTCUSTOMLISTBOX(Cl);
|
||||||
|
RIRegisterTLISTBOX(Cl);
|
||||||
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
RIRegisterTSCROLLBAR(Cl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
12454
Units/PascalScript/uPSRuntime.pas
Normal file
12454
Units/PascalScript/uPSRuntime.pas
Normal file
File diff suppressed because it is too large
Load Diff
1592
Units/PascalScript/uPSUtils.pas
Normal file
1592
Units/PascalScript/uPSUtils.pas
Normal file
File diff suppressed because it is too large
Load Diff
17
Units/PascalScript/uPS_ExtReg.pas
Normal file
17
Units/PascalScript/uPS_ExtReg.pas
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
unit uPS_ExtReg;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses classes, uPSI_IBX, uPSI_Mask, upSI_JvMail, uPSI_Dialogs, uPSI_Registry;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterComponents('Pascal Script', [TPSImport_IBX, TPSImport_Mask, TPSImport_JvMail,
|
||||||
|
TPSImport_Dialogs, TPSImport_Registry]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
366
Units/PascalScript/uROPSImports.pas
Normal file
366
Units/PascalScript/uROPSImports.pas
Normal file
@ -0,0 +1,366 @@
|
|||||||
|
unit uROPSImports;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
uPSCompiler, uPSRuntime, uROBINMessage, uROIndyHTTPChannel,
|
||||||
|
uROXMLSerializer, uROIndyTCPChannel, idTcpClient,
|
||||||
|
uROPSServerLink, uROWinInetHttpChannel;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SIRegisterTROBINMESSAGE(CL: TIFPSPascalCompiler);
|
||||||
|
procedure SIRegisterTROINDYHTTPCHANNEL(CL: TIFPSPascalCompiler);
|
||||||
|
procedure SIRegisterTROINDYTCPCHANNEL(CL: TIFPSPascalCompiler);
|
||||||
|
procedure SIRegisterTIDTCPCLIENT(CL: TIFPSPascalCompiler);
|
||||||
|
procedure SIRegisterRODLImports(Cl: TIFPSPascalCompiler);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure RIRegisterTROBINMESSAGE(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTROINDYHTTPCHANNEL(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTROINDYTCPCHANNEL(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterTIDTCPCLIENT(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
procedure RIRegisterRODLImports(CL: TIFPSRuntimeClassImporter);
|
||||||
|
(*
|
||||||
|
Todo:
|
||||||
|
TROWinInetHTTPChannel = class(TROTransportChannel, IROTransport, IROTCPTransport, IROHTTPTransport)
|
||||||
|
published
|
||||||
|
property UserAgent:string read GetUserAgent write SetUserAgent;
|
||||||
|
property TargetURL : string read fTargetURL write SetTargetURL;
|
||||||
|
property StoreConnected:boolean read fStoreConnected write fStoreConnected default false;
|
||||||
|
property KeepConnection:boolean read fKeepConnection write fKeepConnection default false;
|
||||||
|
end;
|
||||||
|
*)
|
||||||
|
type
|
||||||
|
|
||||||
|
TPSROIndyTCPModule = class(TPSROModule)
|
||||||
|
protected
|
||||||
|
class procedure ExecImp(exec: TIFPSExec; ri: TIFPSRuntimeClassImporter); override;
|
||||||
|
class procedure CompImp(comp: TIFPSPascalCompiler); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPSROIndyHTTPModule = class(TPSROModule)
|
||||||
|
protected
|
||||||
|
class procedure ExecImp(exec: TIFPSExec; ri: TIFPSRuntimeClassImporter); override;
|
||||||
|
class procedure CompImp(comp: TIFPSPascalCompiler); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPSROBinModule = class(TPSROModule)
|
||||||
|
protected
|
||||||
|
class procedure ExecImp(exec: TIFPSExec; ri: TIFPSRuntimeClassImporter); override;
|
||||||
|
class procedure CompImp(comp: TIFPSPascalCompiler); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{procedure TROSOAPMESSAGESERIALIZATIONOPTIONS_W(Self: TROSOAPMESSAGE;
|
||||||
|
const T: TXMLSERIALIZATIONOPTIONS);
|
||||||
|
begin
|
||||||
|
Self.SERIALIZATIONOPTIONS := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROSOAPMESSAGESERIALIZATIONOPTIONS_R(Self: TROSOAPMESSAGE;
|
||||||
|
var T: TXMLSERIALIZATIONOPTIONS);
|
||||||
|
begin
|
||||||
|
T := Self.SERIALIZATIONOPTIONS;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROSOAPMESSAGECUSTOMLOCATION_W(Self: TROSOAPMESSAGE; const T: string);
|
||||||
|
begin
|
||||||
|
Self.CUSTOMLOCATION := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROSOAPMESSAGECUSTOMLOCATION_R(Self: TROSOAPMESSAGE; var T: string);
|
||||||
|
begin
|
||||||
|
T := Self.CUSTOMLOCATION;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROSOAPMESSAGELIBRARYNAME_W(Self: TROSOAPMESSAGE; const T: string);
|
||||||
|
begin
|
||||||
|
Self.LIBRARYNAME := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROSOAPMESSAGELIBRARYNAME_R(Self: TROSOAPMESSAGE; var T: string);
|
||||||
|
begin
|
||||||
|
T := Self.LIBRARYNAME;
|
||||||
|
end; }
|
||||||
|
|
||||||
|
procedure TROBINMESSAGEUSECOMPRESSION_W(Self: TROBINMESSAGE; const T: boolean);
|
||||||
|
begin
|
||||||
|
Self.USECOMPRESSION := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROBINMESSAGEUSECOMPRESSION_R(Self: TROBINMESSAGE; var T: boolean);
|
||||||
|
begin
|
||||||
|
T := Self.USECOMPRESSION;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROINDYHTTPCHANNELTARGETURL_W(Self: TROINDYHTTPCHANNEL; const T: string);
|
||||||
|
begin
|
||||||
|
Self.TARGETURL := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROINDYHTTPCHANNELTARGETURL_R(Self: TROINDYHTTPCHANNEL; var T: string);
|
||||||
|
begin
|
||||||
|
T := Self.TARGETURL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TROINDYTCPCHANNELINDYCLIENT_R(Self: TROINDYTCPCHANNEL; var T: TIdTCPClientBaseClass);
|
||||||
|
begin
|
||||||
|
T := Self.INDYCLIENT;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTPORT_W(Self: TIDTCPCLIENT; const T: integer);
|
||||||
|
begin
|
||||||
|
Self.PORT := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTPORT_R(Self: TIdTCPClientBaseClass; var T: integer);
|
||||||
|
begin
|
||||||
|
T := TIdIndy10HackClient(Self).PORT;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTHOST_W(Self: TIdTCPClientBaseClass; const T: string);
|
||||||
|
begin
|
||||||
|
TIdIndy10HackClient(Self).HOST := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTHOST_R(Self: TIdTCPClientBaseClass; var T: string);
|
||||||
|
begin
|
||||||
|
T := TIdIndy10HackClient(Self).HOST;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{procedure TIDTCPCLIENTBOUNDPORT_W(Self: TIdTCPClientBaseClass; const T: integer);
|
||||||
|
begin
|
||||||
|
Self.BOUNDPORT := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTBOUNDPORT_R(Self: TIdTCPClientBaseClass; var T: integer);
|
||||||
|
begin
|
||||||
|
T := Self.BOUNDPORT;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTBOUNDIP_W(Self: TIdTCPClientBaseClass; const T: string);
|
||||||
|
begin
|
||||||
|
Self.BOUNDIP := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTBOUNDIP_R(Self: TIdTCPClientBaseClass; var T: string);
|
||||||
|
begin
|
||||||
|
T := Self.BOUNDIP;
|
||||||
|
end;]
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTBOUNDPORTMIN_W(Self: TIdTCPClientBaseClass; const T: integer);
|
||||||
|
begin
|
||||||
|
Self.BOUNDPORTMIN := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTBOUNDPORTMIN_R(Self: TIdTCPClientBaseClass; var T: integer);
|
||||||
|
begin
|
||||||
|
T := Self.BOUNDPORTMIN;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTBOUNDPORTMAX_W(Self: TIdTCPClientBaseClass; const T: integer);
|
||||||
|
begin
|
||||||
|
Self.BOUNDPORTMAX := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIDTCPCLIENTBOUNDPORTMAX_R(Self: TIdTCPClientBaseClass; var T: integer);
|
||||||
|
begin
|
||||||
|
T := Self.BOUNDPORTMAX;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{procedure RIRegisterTROSOAPMESSAGE(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TROSOAPMESSAGE) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TROSOAPMESSAGELIBRARYNAME_R, @TROSOAPMESSAGELIBRARYNAME_W,
|
||||||
|
'LIBRARYNAME');
|
||||||
|
RegisterPropertyHelper(@TROSOAPMESSAGECUSTOMLOCATION_R,
|
||||||
|
@TROSOAPMESSAGECUSTOMLOCATION_W, 'CUSTOMLOCATION');
|
||||||
|
RegisterPropertyHelper(@TROSOAPMESSAGESERIALIZATIONOPTIONS_R,
|
||||||
|
@TROSOAPMESSAGESERIALIZATIONOPTIONS_W, 'SERIALIZATIONOPTIONS');
|
||||||
|
end;
|
||||||
|
end; }
|
||||||
|
|
||||||
|
procedure RIRegisterTROBINMESSAGE(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TROBINMESSAGE) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TROBINMESSAGEUSECOMPRESSION_R,
|
||||||
|
@TROBINMESSAGEUSECOMPRESSION_W, 'USECOMPRESSION');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTROINDYHTTPCHANNEL(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TROINDYHTTPCHANNEL) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TROINDYHTTPCHANNELTARGETURL_R,
|
||||||
|
@TROINDYHTTPCHANNELTARGETURL_W, 'TARGETURL');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTROINDYTCPCHANNEL(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TROINDYTCPCHANNEL) do
|
||||||
|
begin
|
||||||
|
RegisterPropertyHelper(@TROINDYTCPCHANNELINDYCLIENT_R, nil, 'INDYCLIENT');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterTIDTCPCLIENT(Cl: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
with Cl.Add(TIdTCPClientBaseClass) do
|
||||||
|
begin
|
||||||
|
{RegisterPropertyHelper(@TIDTCPCLIENTBOUNDPORTMAX_R, @TIDTCPCLIENTBOUNDPORTMAX_W,
|
||||||
|
'BOUNDPORTMAX');
|
||||||
|
RegisterPropertyHelper(@TIDTCPCLIENTBOUNDPORTMIN_R, @TIDTCPCLIENTBOUNDPORTMIN_W,
|
||||||
|
'BOUNDPORTMIN');
|
||||||
|
RegisterPropertyHelper(@TIDTCPCLIENTBOUNDIP_R, @TIDTCPCLIENTBOUNDIP_W, 'BOUNDIP');
|
||||||
|
RegisterPropertyHelper(@TIDTCPCLIENTBOUNDPORT_R, @TIDTCPCLIENTBOUNDPORT_W,
|
||||||
|
'BOUNDPORT');}
|
||||||
|
RegisterPropertyHelper(@TIDTCPCLIENTHOST_R, @TIDTCPCLIENTHOST_W, 'HOST');
|
||||||
|
RegisterPropertyHelper(@TIDTCPCLIENTPORT_R, @TIDTCPCLIENTPORT_W, 'PORT');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegisterRODLImports(CL: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegisterTIDTCPCLIENT(Cl);
|
||||||
|
RIRegisterTROINDYTCPCHANNEL(Cl);
|
||||||
|
RIRegisterTROINDYHTTPCHANNEL(Cl);
|
||||||
|
RIRegisterTROBINMESSAGE(Cl);
|
||||||
|
//RIRegisterTROSOAPMESSAGE(Cl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RegClassS(cl: TIFPSPascalCompiler; const InheritsFrom,
|
||||||
|
ClassName: string): TPSCompileTimeClass;
|
||||||
|
begin
|
||||||
|
Result := cl.FindClass(ClassName);
|
||||||
|
if Result = nil then
|
||||||
|
Result := cl.AddClassN(cl.FindClass(InheritsFrom), ClassName)
|
||||||
|
else
|
||||||
|
Result.ClassInheritsFrom := cl.FindClass(InheritsFrom);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{procedure SIRegisterTROSOAPMESSAGE(CL: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
Cl.addTypeS('TXMLSERIALIZATIONOPTIONS', 'BYTE');
|
||||||
|
Cl.AddConstantN('XSOWRITEMULTIREFARRAY', 'BYTE').SetInt(1);
|
||||||
|
Cl.AddConstantN('XSOWRITEMULTIREFOBJECT', 'BYTE').SetInt(2);
|
||||||
|
Cl.AddConstantN('XSOSENDUNTYPED', 'BYTE').SetInt(4);
|
||||||
|
with RegClassS(cl, 'TROMESSAGE', 'TROSOAPMESSAGE') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('LIBRARYNAME', 'STRING', iptrw);
|
||||||
|
RegisterProperty('CUSTOMLOCATION', 'STRING', iptrw);
|
||||||
|
RegisterProperty('SERIALIZATIONOPTIONS', 'TXMLSERIALIZATIONOPTIONS', iptrw);
|
||||||
|
end;
|
||||||
|
end;}
|
||||||
|
|
||||||
|
procedure SIRegisterTROBINMESSAGE(CL: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with RegClassS(cl, 'TROMESSAGE', 'TROBINMESSAGE') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('USECOMPRESSION', 'BOOLEAN', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTROINDYHTTPCHANNEL(CL: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with RegClassS(cl, 'TROINDYTCPCHANNEL', 'TROINDYHTTPCHANNEL') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('TARGETURL', 'STRING', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTROINDYTCPCHANNEL(CL: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with RegClassS(cl, 'TROTRANSPORTCHANNEL', 'TROINDYTCPCHANNEL') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('INDYCLIENT', 'TIdTCPClientBaseClass', iptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterTIDTCPCLIENT(CL: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with RegClassS(cl, 'TCOMPONENT', 'TIdTCPClientBaseClass') do
|
||||||
|
begin
|
||||||
|
RegisterProperty('BOUNDPORTMAX', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('BOUNDPORTMIN', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('BOUNDIP', 'STRING', iptrw);
|
||||||
|
RegisterProperty('BOUNDPORT', 'INTEGER', iptrw);
|
||||||
|
RegisterProperty('HOST', 'STRING', iptrw);
|
||||||
|
RegisterProperty('PORT', 'INTEGER', iptrw);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegisterRODLImports(Cl: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegisterTIDTCPCLIENT(Cl);
|
||||||
|
SIRegisterTROINDYTCPCHANNEL(Cl);
|
||||||
|
SIRegisterTROINDYHTTPCHANNEL(Cl);
|
||||||
|
SIRegisterTROBINMESSAGE(Cl);
|
||||||
|
//SIRegisterTROSOAPMESSAGE(Cl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSROIndyTCPModule }
|
||||||
|
|
||||||
|
class procedure TPSROIndyTCPModule.CompImp(comp: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegisterTIDTCPCLIENT(Comp);
|
||||||
|
SIRegisterTROINDYTCPCHANNEL(Comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TPSROIndyTCPModule.ExecImp(exec: TIFPSExec;
|
||||||
|
ri: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegisterTIDTCPCLIENT(ri);
|
||||||
|
RIRegisterTROINDYTCPCHANNEL(ri);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSROIndyHTTPModule }
|
||||||
|
|
||||||
|
class procedure TPSROIndyHTTPModule.CompImp(comp: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
if Comp.FindClass('TROINDYTCPCHANNEL') = nil then
|
||||||
|
TPSROIndyTCPModule.CompImp(Comp);
|
||||||
|
SIRegisterTROINDYHTTPCHANNEL(Comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TPSROIndyHTTPModule.ExecImp(exec: TIFPSExec;
|
||||||
|
ri: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
if ri.FindClass('TROINDYTCPCHANNEL') = nil then
|
||||||
|
TPSROIndyTCPModule.ExecImp(exec, ri);
|
||||||
|
RIRegisterTROINDYHTTPCHANNEL(ri);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPSROSoapModule }
|
||||||
|
|
||||||
|
{class procedure TPSROSoapModule.CompImp(comp: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegisterTROSOAPMESSAGE(comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TPSROSoapModule.ExecImp(exec: TIFPSExec;
|
||||||
|
ri: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegisterTROSOAPMESSAGE(ri);
|
||||||
|
end;}
|
||||||
|
|
||||||
|
{ TPSROBinModule }
|
||||||
|
|
||||||
|
class procedure TPSROBinModule.CompImp(comp: TIFPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegisterTROBINMESSAGE(Comp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TPSROBinModule.ExecImp(exec: TIFPSExec;
|
||||||
|
ri: TIFPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
|
RIRegisterTROBINMESSAGE(ri);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
1231
Units/PascalScript/uROPSServerLink.pas
Normal file
1231
Units/PascalScript/uROPSServerLink.pas
Normal file
File diff suppressed because it is too large
Load Diff
513
Units/PascalScript/x64.inc
Normal file
513
Units/PascalScript/x64.inc
Normal file
@ -0,0 +1,513 @@
|
|||||||
|
{ implementation of x64 abi }
|
||||||
|
//procedure DebugBreak; external 'Kernel32.dll';
|
||||||
|
const
|
||||||
|
EmptyPchar: array[0..0] of char = #0;
|
||||||
|
{$ASMMODE INTEL}
|
||||||
|
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
procedure x64call(
|
||||||
|
Address: Pointer;
|
||||||
|
out _RAX: IPointer;
|
||||||
|
_RCX, _RDX, _R8, _R9: IPointer;
|
||||||
|
var _XMM0: Double;
|
||||||
|
_XMM1, _XMM2, _XMM3: Double;
|
||||||
|
aStack: Pointer; aItems: Integer); assembler; nostackframe;
|
||||||
|
asm
|
||||||
|
(* Registers:
|
||||||
|
RCX: Address
|
||||||
|
RDX: *_RAX
|
||||||
|
R8: _RCX
|
||||||
|
R9: _RDX
|
||||||
|
|
||||||
|
fpc inserts an 20h emty space
|
||||||
|
*)
|
||||||
|
push ebp
|
||||||
|
mov ebp,esp
|
||||||
|
// call debugbreak
|
||||||
|
push rcx // address
|
||||||
|
push rdx // _rax
|
||||||
|
push r8 // _rcx
|
||||||
|
push r9 // _rdx
|
||||||
|
mov rcx, aItems
|
||||||
|
mov rdx, aStack
|
||||||
|
jmp @compareitems
|
||||||
|
@work:
|
||||||
|
push [rdx]
|
||||||
|
dec rcx
|
||||||
|
sub rdx,8
|
||||||
|
@compareitems:
|
||||||
|
or rcx, rcx
|
||||||
|
jnz @work
|
||||||
|
|
||||||
|
// copy registers
|
||||||
|
movd xmm0,[_XMM0]
|
||||||
|
movd xmm1,_XMM1
|
||||||
|
movd xmm2,_XMM2
|
||||||
|
movd xmm3,_XMM3
|
||||||
|
mov RAX, [rbp-8]
|
||||||
|
mov RCX, [rbp-24]
|
||||||
|
mov RDX, [rbp-32]
|
||||||
|
mov R8, _R8
|
||||||
|
mov R9, _R9
|
||||||
|
|
||||||
|
// weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in
|
||||||
|
sub RSP, 32
|
||||||
|
|
||||||
|
call RAX
|
||||||
|
|
||||||
|
add RSP, 32 // undo the damage done earlier
|
||||||
|
|
||||||
|
// copy result back
|
||||||
|
mov RDX, [rbp-16]
|
||||||
|
mov [RDX], RAX
|
||||||
|
movd [_XMM0],xmm0
|
||||||
|
|
||||||
|
pop r9
|
||||||
|
pop r8
|
||||||
|
pop rdx
|
||||||
|
pop rcx
|
||||||
|
leave
|
||||||
|
ret
|
||||||
|
end;
|
||||||
|
{$ELSE}
|
||||||
|
procedure x64call(
|
||||||
|
Address: Pointer;
|
||||||
|
out _RAX: IPointer;
|
||||||
|
_RDI, _RSI, _RDX, _RCX, _R8, _R9: IPointer;
|
||||||
|
var _XMM0: Double;
|
||||||
|
_XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7: Double;
|
||||||
|
aStack: Pointer; aItems: Integer); assembler; nostackframe;
|
||||||
|
|
||||||
|
|
||||||
|
asm
|
||||||
|
(* Registers:
|
||||||
|
RDI: Address
|
||||||
|
RSI: _RAX
|
||||||
|
RDX: _RDI
|
||||||
|
RCX: _RSI
|
||||||
|
R8: _RDX
|
||||||
|
R9: _RCX
|
||||||
|
|
||||||
|
|
||||||
|
*)
|
||||||
|
push ebp
|
||||||
|
mov ebp,esp
|
||||||
|
push rdi // address
|
||||||
|
push rsi // _rax
|
||||||
|
push rdx // _rdi
|
||||||
|
push rcx // _rsi
|
||||||
|
push r8 // _rdx
|
||||||
|
push r9 // _rcx
|
||||||
|
mov rcx, aItems
|
||||||
|
mov rdx, aStack
|
||||||
|
jmp @compareitems
|
||||||
|
@work:
|
||||||
|
push [rdx]
|
||||||
|
dec rcx
|
||||||
|
sub rdx,8
|
||||||
|
@compareitems:
|
||||||
|
or rcx, rcx
|
||||||
|
jnz @work
|
||||||
|
|
||||||
|
// copy registers
|
||||||
|
movd xmm0,[_XMM0]
|
||||||
|
movd xmm1,_XMM1
|
||||||
|
movd xmm2,_XMM2
|
||||||
|
movd xmm3,_XMM3
|
||||||
|
movd xmm4,_XMM4
|
||||||
|
movd xmm5,_XMM5
|
||||||
|
movd xmm6,_XMM6
|
||||||
|
movd xmm7,_XMM7
|
||||||
|
mov RAX, [rbp-8]
|
||||||
|
mov RDI, [rbp-24]
|
||||||
|
mov RSI, [rbp-32]
|
||||||
|
mov RDX, [rbp-40]
|
||||||
|
mov RCX, [rbp-48]
|
||||||
|
mov R8, _R8
|
||||||
|
mov R9, _R9
|
||||||
|
|
||||||
|
// weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in; not sure about linux
|
||||||
|
//sub RSP, 32
|
||||||
|
|
||||||
|
call RAX
|
||||||
|
|
||||||
|
// add RSP, 32 // undo the damage done earlier
|
||||||
|
|
||||||
|
// copy result back
|
||||||
|
mov RDX, [rbp-16]
|
||||||
|
mov [RDX], RAX
|
||||||
|
movd [_XMM0],xmm0
|
||||||
|
|
||||||
|
pop r9
|
||||||
|
pop r8
|
||||||
|
pop rdx
|
||||||
|
pop rcx
|
||||||
|
pop rsi
|
||||||
|
pop rdi
|
||||||
|
leave
|
||||||
|
ret
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
|
||||||
|
var
|
||||||
|
Stack: array of Byte;
|
||||||
|
_RAX,
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
_RCX, _RDX, _R8, _R9: IPointer;
|
||||||
|
_XMM0, _XMM1, _XMM2, _XMM3: Double;
|
||||||
|
{$ELSE}
|
||||||
|
_RDI, _RSI, _RDX, _RCX, _R8, _R9: IPointer;
|
||||||
|
_XMM0, _XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7: Double;
|
||||||
|
RegUsageFloat: Byte;
|
||||||
|
{$ENDIF}
|
||||||
|
RegUsage: Byte;
|
||||||
|
CallData: TPSList;
|
||||||
|
I: Integer;
|
||||||
|
pp: ^Byte;
|
||||||
|
|
||||||
|
function rp(p: PPSVariantIFC): PPSVariantIFC;
|
||||||
|
begin
|
||||||
|
if p = nil then
|
||||||
|
begin
|
||||||
|
result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if p.aType.BaseType = btPointer then
|
||||||
|
begin
|
||||||
|
p^.aType := Pointer(Pointer(IPointer(p^.dta) + PointerSize)^);
|
||||||
|
p^.Dta := Pointer(p^.dta^);
|
||||||
|
end;
|
||||||
|
Result := p;
|
||||||
|
end;
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
procedure StoreReg(data: IPointer); overload;
|
||||||
|
var p: Pointer;
|
||||||
|
begin
|
||||||
|
case RegUsage of
|
||||||
|
0: begin inc(RegUsage); _RCX:=Data; end;
|
||||||
|
1: begin inc(RegUsage); _RDX:=Data; end;
|
||||||
|
2: begin inc(RegUsage); _R8:=Data; end;
|
||||||
|
3: begin inc(RegUsage); _R9:=Data; end;
|
||||||
|
else begin
|
||||||
|
SetLength(Stack, Length(Stack)+8);
|
||||||
|
p := @Stack[LEngth(Stack)-8];
|
||||||
|
IPointer(p^) := data;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ELSE}
|
||||||
|
procedure StoreReg(data: IPointer); overload;
|
||||||
|
var p: Pointer;
|
||||||
|
begin
|
||||||
|
case RegUsage of
|
||||||
|
0: begin inc(RegUsage); _RDI:=Data; end;
|
||||||
|
1: begin inc(RegUsage); _RSI:=Data; end;
|
||||||
|
2: begin inc(RegUsage); _RDX:=Data; end;
|
||||||
|
3: begin inc(RegUsage); _RCX:=Data; end;
|
||||||
|
4: begin inc(RegUsage); _R8:=Data; end;
|
||||||
|
5: begin inc(RegUsage); _R9:=Data; end;
|
||||||
|
else begin
|
||||||
|
SetLength(Stack, Length(Stack)+8);
|
||||||
|
p := @Stack[LEngth(Stack)-8];
|
||||||
|
IPointer(p^) := data;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure StoreStack(const aData; Len: Integer);
|
||||||
|
var
|
||||||
|
p: Pointer;
|
||||||
|
begin
|
||||||
|
if Len > 8 then
|
||||||
|
if Length(Stack) mod 16 <> 0 then begin
|
||||||
|
SetLength(Stack, Length(Stack)+ (16-(Length(Stack) mod 16)));
|
||||||
|
end;
|
||||||
|
SetLength(Stack, Length(Stack)+Len);
|
||||||
|
p := @Stack[Length(Stack)-Len];
|
||||||
|
Move(aData, p^, Len);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
procedure StoreReg(data: Double); overload;
|
||||||
|
var p: Pointer;
|
||||||
|
begin
|
||||||
|
case RegUsage of
|
||||||
|
0: begin inc(RegUsage); _XMM0:=Data; end;
|
||||||
|
1: begin inc(RegUsage); _XMM1:=Data; end;
|
||||||
|
2: begin inc(RegUsage); _XMM2:=Data; end;
|
||||||
|
3: begin inc(RegUsage); _XMM3:=Data; end;
|
||||||
|
else begin
|
||||||
|
SetLength(Stack, Length(Stack)+8);
|
||||||
|
p := @Stack[LEngth(Stack)-8];
|
||||||
|
Double(p^) := data;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ELSE}
|
||||||
|
procedure StoreReg(data: Double); overload;
|
||||||
|
var p: Pointer;
|
||||||
|
begin
|
||||||
|
case RegUsageFloat of
|
||||||
|
0: begin inc(RegUsageFloat); _XMM0:=Data; end;
|
||||||
|
1: begin inc(RegUsageFloat); _XMM1:=Data; end;
|
||||||
|
2: begin inc(RegUsageFloat); _XMM2:=Data; end;
|
||||||
|
3: begin inc(RegUsageFloat); _XMM3:=Data; end;
|
||||||
|
4: begin inc(RegUsageFloat); _XMM4:=Data; end;
|
||||||
|
5: begin inc(RegUsageFloat); _XMM5:=Data; end;
|
||||||
|
6: begin inc(RegUsageFloat); _XMM6:=Data; end;
|
||||||
|
7: begin inc(RegUsageFloat); _XMM7:=Data; end;
|
||||||
|
else begin
|
||||||
|
SetLength(Stack, Length(Stack)+8);
|
||||||
|
p := @Stack[LEngth(Stack)-8];
|
||||||
|
Double(p^) := data;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
function GetPtr(fVar: PPSVariantIFC): Boolean;
|
||||||
|
var
|
||||||
|
varPtr: Pointer;
|
||||||
|
//UseReg: Boolean;
|
||||||
|
//tempstr: tbtstring;
|
||||||
|
p: Pointer;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if FVar = nil then exit;
|
||||||
|
if fVar.VarParam then
|
||||||
|
begin
|
||||||
|
case fvar.aType.BaseType of
|
||||||
|
btArray:
|
||||||
|
begin
|
||||||
|
if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then
|
||||||
|
begin
|
||||||
|
p := CreateOpenArray(True, Self, FVar);
|
||||||
|
if p = nil then exit;
|
||||||
|
CallData.Add(p);
|
||||||
|
StoreReg(IPointer(POpenArray(p)^.Data));
|
||||||
|
StoreReg(IPointer(POpenArray(p)^.ItemCount -1));
|
||||||
|
Result := True;
|
||||||
|
Exit;
|
||||||
|
end else begin
|
||||||
|
varptr := fvar.Dta;
|
||||||
|
// Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
btVariant,
|
||||||
|
btSet,
|
||||||
|
btStaticArray,
|
||||||
|
btRecord,
|
||||||
|
btInterface,
|
||||||
|
btClass,
|
||||||
|
{$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16,
|
||||||
|
btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
|
||||||
|
{$IFNDEF PS_NOINT64}, bts64{$ENDIF}:
|
||||||
|
begin
|
||||||
|
Varptr := fvar.Dta;
|
||||||
|
end;
|
||||||
|
else begin
|
||||||
|
exit; //invalid type
|
||||||
|
end;
|
||||||
|
end; {case}
|
||||||
|
|
||||||
|
StoreReg(IPointer(VarPtr));
|
||||||
|
end else begin
|
||||||
|
// UseReg := True;
|
||||||
|
case fVar^.aType.BaseType of
|
||||||
|
btSet:
|
||||||
|
begin
|
||||||
|
case TPSTypeRec_Set(fvar.aType).aByteSize of
|
||||||
|
1: StoreReg(IPointer(byte(fvar.dta^)));
|
||||||
|
2: StoreReg(IPointer(word(fvar.dta^)));
|
||||||
|
3, 4: StoreReg(IPointer(cardinal(fvar.dta^)));
|
||||||
|
5,6,7,8: StoreReg(IPointer(fVar.Dta^));
|
||||||
|
else
|
||||||
|
StoreReg(IPointer(fvar.Dta));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
btArray:
|
||||||
|
begin
|
||||||
|
if Copy(fvar^.aType.ExportName, 1, 10) = '!OPENARRAY' then
|
||||||
|
begin
|
||||||
|
p := CreateOpenArray(False, SElf, FVar);
|
||||||
|
if p =nil then exit;
|
||||||
|
CallData.Add(p);
|
||||||
|
StoreReg(IPointer(POpenArray(p)^.Data));
|
||||||
|
StoreReg(IPointer(POpenArray(p)^.ItemCount -1));
|
||||||
|
Result := True;
|
||||||
|
exit;
|
||||||
|
end else begin
|
||||||
|
StoreReg(IPointer(FVar.Dta^));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
btVariant
|
||||||
|
, btStaticArray, btRecord:
|
||||||
|
begin
|
||||||
|
StoreReg(IPointer(fVar.Dta));
|
||||||
|
end;
|
||||||
|
btExtended, btDouble: {8 bytes} begin
|
||||||
|
StoreReg(double(fvar.dta^));
|
||||||
|
end;
|
||||||
|
btCurrency: {8 bytes} begin
|
||||||
|
StoreReg(IPointer(fvar.dta^));
|
||||||
|
end;
|
||||||
|
btSingle: {4 bytes} begin
|
||||||
|
StoreReg(single(fvar.dta^));
|
||||||
|
end;
|
||||||
|
|
||||||
|
btChar,
|
||||||
|
btU8,
|
||||||
|
btS8: begin
|
||||||
|
StoreReg(IPointer(byte(fVar^.dta^)));
|
||||||
|
end;
|
||||||
|
btWideChar,
|
||||||
|
btu16, btS16: begin
|
||||||
|
StoreReg(IPointer(word(fVar^.dta^)));
|
||||||
|
end;
|
||||||
|
btu32, bts32: begin
|
||||||
|
StoreReg(IPointer(cardinal(fVar^.dta^)));
|
||||||
|
end;
|
||||||
|
btPchar:
|
||||||
|
begin
|
||||||
|
if pointer(fvar^.dta^) = nil then
|
||||||
|
StoreReg(IPointer(@EmptyPchar))
|
||||||
|
else
|
||||||
|
StoreReg(IPointer(fvar^.dta^));
|
||||||
|
end;
|
||||||
|
btclass, btinterface, btString:
|
||||||
|
begin
|
||||||
|
StoreReg(IPointer(fvar^.dta^));
|
||||||
|
end;
|
||||||
|
btWideString: begin
|
||||||
|
StoreReg(IPointer(fvar^.dta^));
|
||||||
|
end;
|
||||||
|
btUnicodeString: begin
|
||||||
|
StoreReg(IPointer(fvar^.dta^));
|
||||||
|
end;
|
||||||
|
|
||||||
|
btProcPtr:
|
||||||
|
begin
|
||||||
|
GetMem(p, PointerSize2);
|
||||||
|
TMethod(p^) := MKMethod(Self, Longint(FVar.Dta^));
|
||||||
|
StoreStack(p^, Pointersize2);
|
||||||
|
FreeMem(p);
|
||||||
|
end;
|
||||||
|
|
||||||
|
bts64:
|
||||||
|
begin
|
||||||
|
StoreReg(IPointer(int64(fvar^.dta^)));
|
||||||
|
end;
|
||||||
|
end; {case}
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
InnerfuseCall := False;
|
||||||
|
if Address = nil then
|
||||||
|
exit; // need address
|
||||||
|
SetLength(Stack, 0);
|
||||||
|
CallData := TPSList.Create;
|
||||||
|
res := rp(res);
|
||||||
|
if res <> nil then
|
||||||
|
res.VarParam := true;
|
||||||
|
try
|
||||||
|
{$IFNDEF WINDOWS}
|
||||||
|
_RSI := 0;
|
||||||
|
_RDI := 0;
|
||||||
|
_XMM4 := 0;
|
||||||
|
_XMM5 := 0;
|
||||||
|
_XMM6 := 0;
|
||||||
|
_XMM7 := 0;
|
||||||
|
RegUsageFloat := 0;
|
||||||
|
{$ENDIF}
|
||||||
|
_RCX := 0;
|
||||||
|
_RDX := 0;
|
||||||
|
_R8 := 0;
|
||||||
|
_R9 := 0;
|
||||||
|
_XMM0 := 0;
|
||||||
|
_XMM1 := 0;
|
||||||
|
_XMM2 := 0;
|
||||||
|
_XMM3 := 0;
|
||||||
|
RegUsage := 0;
|
||||||
|
if assigned(_Self) then begin
|
||||||
|
RegUsage := 1;
|
||||||
|
_RCX := IPointer(_Self);
|
||||||
|
end;
|
||||||
|
for I := 0 to Params.Count - 1 do
|
||||||
|
begin
|
||||||
|
if not GetPtr(rp(Params[I])) then Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if assigned(res) then begin
|
||||||
|
case res^.aType.BaseType of
|
||||||
|
{$IFDEF x64_string_result_as_varparameter}
|
||||||
|
btstring, btWideString, btUnicodeString,
|
||||||
|
{$ENDIF}
|
||||||
|
btInterface, btArray, btrecord, btVariant, btStaticArray: GetPtr(res);
|
||||||
|
btSet:
|
||||||
|
begin
|
||||||
|
if TPSTypeRec_Set(res.aType).aByteSize > PointerSize then GetPtr(res);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
|
||||||
|
{$ELSE}
|
||||||
|
x64call(Address, _RAX, _RDI, _RSI, _RDX, _RCX, _R8, _R9,_XMM0,_XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7, pp, Length(Stack) div 8);
|
||||||
|
{$ENDIF}
|
||||||
|
case res^.aType.BaseType of
|
||||||
|
btSet:
|
||||||
|
begin
|
||||||
|
case TPSTypeRec_Set(res.aType).aByteSize of
|
||||||
|
1: byte(res.Dta^) := _RAX;
|
||||||
|
2: word(res.Dta^) := _RAX;
|
||||||
|
3,
|
||||||
|
4: Longint(res.Dta^) := _RAX;
|
||||||
|
5,6,7,8: IPointer(res.dta^) := _RAX;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
btSingle: tbtsingle(res.Dta^) := _XMM0;
|
||||||
|
btDouble: tbtdouble(res.Dta^) := _XMM0;
|
||||||
|
btExtended: tbtextended(res.Dta^) := _XMM0;
|
||||||
|
btchar,btU8, btS8: tbtu8(res.dta^) := _RAX;
|
||||||
|
btWideChar, btu16, bts16: tbtu16(res.dta^) := _RAX;
|
||||||
|
btClass : IPointer(res.dta^) := _RAX;
|
||||||
|
btu32,bts32: tbtu32(res.dta^) := _RAX;
|
||||||
|
btPChar: pansichar(res.dta^) := Pansichar(_RAX);
|
||||||
|
bts64: tbts64(res.dta^) := Int64(_RAX);
|
||||||
|
btCurrency: tbtCurrency(res.Dta^) := Int64(_RAX);
|
||||||
|
btInterface,
|
||||||
|
btVariant,
|
||||||
|
{$IFDEF x64_string_result_as_varparameter}
|
||||||
|
btWidestring,btUnicodestring, btstring ,
|
||||||
|
{$ENDIF}
|
||||||
|
btStaticArray, btArray, btrecord:;
|
||||||
|
{$IFNDEF x64_string_result_as_varparameter}
|
||||||
|
btUnicodeString, btWideString, btstring: Int64(res.dta^) := _RAX;
|
||||||
|
{$ENDIF}
|
||||||
|
else
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
|
||||||
|
{$ELSE}
|
||||||
|
x64call(Address, _RAX, _RDI, _RSI, _RDX, _RCX, _R8, _R9,_XMM0,_XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7, pp, Length(Stack) div 8);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
for i := CallData.Count -1 downto 0 do
|
||||||
|
begin
|
||||||
|
pp := CallData[i];
|
||||||
|
case pp^ of
|
||||||
|
0: DestroyOpenArray(Self, Pointer(pp));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
CallData.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
739
Units/PascalScript/x86.inc
Normal file
739
Units/PascalScript/x86.inc
Normal file
@ -0,0 +1,739 @@
|
|||||||
|
{ implementation of x86 abi }
|
||||||
|
{$ifdef FPC}
|
||||||
|
{$define PS_ARRAY_ON_STACK}
|
||||||
|
{$endif}
|
||||||
|
function RealFloatCall_Register(p: Pointer;
|
||||||
|
_EAX, _EDX, _ECX: Cardinal;
|
||||||
|
StackData: Pointer;
|
||||||
|
StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
|
||||||
|
): Extended; Stdcall; // make sure all things are on stack
|
||||||
|
var
|
||||||
|
E: Extended;
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
mov ecx, stackdatalen
|
||||||
|
jecxz @@2
|
||||||
|
mov eax, stackdata
|
||||||
|
@@1:
|
||||||
|
mov edx, [eax]
|
||||||
|
push edx
|
||||||
|
sub eax, 4
|
||||||
|
dec ecx
|
||||||
|
or ecx, ecx
|
||||||
|
jnz @@1
|
||||||
|
@@2:
|
||||||
|
mov eax,_EAX
|
||||||
|
mov edx,_EDX
|
||||||
|
mov ecx,_ECX
|
||||||
|
call p
|
||||||
|
fstp tbyte ptr [e]
|
||||||
|
end;
|
||||||
|
Result := E;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RealFloatCall_Other(p: Pointer;
|
||||||
|
StackData: Pointer;
|
||||||
|
StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
|
||||||
|
): Extended; Stdcall; // make sure all things are on stack
|
||||||
|
var
|
||||||
|
E: Extended;
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
mov ecx, stackdatalen
|
||||||
|
jecxz @@2
|
||||||
|
mov eax, stackdata
|
||||||
|
@@1:
|
||||||
|
mov edx, [eax]
|
||||||
|
push edx
|
||||||
|
sub eax, 4
|
||||||
|
dec ecx
|
||||||
|
or ecx, ecx
|
||||||
|
jnz @@1
|
||||||
|
@@2:
|
||||||
|
call p
|
||||||
|
fstp tbyte ptr [e]
|
||||||
|
end;
|
||||||
|
Result := E;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RealFloatCall_CDecl(p: Pointer;
|
||||||
|
StackData: Pointer;
|
||||||
|
StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
|
||||||
|
): Extended; Stdcall; // make sure all things are on stack
|
||||||
|
var
|
||||||
|
E: Extended;
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
mov ecx, stackdatalen
|
||||||
|
jecxz @@2
|
||||||
|
mov eax, stackdata
|
||||||
|
@@1:
|
||||||
|
mov edx, [eax]
|
||||||
|
push edx
|
||||||
|
sub eax, 4
|
||||||
|
dec ecx
|
||||||
|
or ecx, ecx
|
||||||
|
jnz @@1
|
||||||
|
@@2:
|
||||||
|
call p
|
||||||
|
fstp tbyte ptr [e]
|
||||||
|
@@5:
|
||||||
|
mov ecx, stackdatalen
|
||||||
|
jecxz @@2
|
||||||
|
@@6:
|
||||||
|
pop edx
|
||||||
|
dec ecx
|
||||||
|
or ecx, ecx
|
||||||
|
jnz @@6
|
||||||
|
end;
|
||||||
|
Result := E;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RealCall_Register(p: Pointer;
|
||||||
|
_EAX, _EDX, _ECX: Cardinal;
|
||||||
|
StackData: Pointer;
|
||||||
|
StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
|
||||||
|
ResultLength: Longint; ResEDX: Pointer): Longint; Stdcall; // make sure all things are on stack
|
||||||
|
var
|
||||||
|
r: Longint;
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
mov ecx, stackdatalen
|
||||||
|
jecxz @@2
|
||||||
|
mov eax, stackdata
|
||||||
|
@@1:
|
||||||
|
mov edx, [eax]
|
||||||
|
push edx
|
||||||
|
sub eax, 4
|
||||||
|
dec ecx
|
||||||
|
or ecx, ecx
|
||||||
|
jnz @@1
|
||||||
|
@@2:
|
||||||
|
mov eax,_EAX
|
||||||
|
mov edx,_EDX
|
||||||
|
mov ecx,_ECX
|
||||||
|
call p
|
||||||
|
mov ecx, resultlength
|
||||||
|
cmp ecx, 0
|
||||||
|
je @@5
|
||||||
|
cmp ecx, 1
|
||||||
|
je @@3
|
||||||
|
cmp ecx, 2
|
||||||
|
je @@4
|
||||||
|
mov r, eax
|
||||||
|
jmp @@5
|
||||||
|
@@3:
|
||||||
|
xor ecx, ecx
|
||||||
|
mov cl, al
|
||||||
|
mov r, ecx
|
||||||
|
jmp @@5
|
||||||
|
@@4:
|
||||||
|
xor ecx, ecx
|
||||||
|
mov cx, ax
|
||||||
|
mov r, ecx
|
||||||
|
@@5:
|
||||||
|
mov ecx, resedx
|
||||||
|
jecxz @@6
|
||||||
|
mov [ecx], edx
|
||||||
|
@@6:
|
||||||
|
end;
|
||||||
|
Result := r;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RealCall_Other(p: Pointer;
|
||||||
|
StackData: Pointer;
|
||||||
|
StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
|
||||||
|
ResultLength: Longint; ResEDX: Pointer): Longint; Stdcall; // make sure all things are on stack
|
||||||
|
var
|
||||||
|
r: Longint;
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
mov ecx, stackdatalen
|
||||||
|
jecxz @@2
|
||||||
|
mov eax, stackdata
|
||||||
|
@@1:
|
||||||
|
mov edx, [eax]
|
||||||
|
push edx
|
||||||
|
sub eax, 4
|
||||||
|
dec ecx
|
||||||
|
or ecx, ecx
|
||||||
|
jnz @@1
|
||||||
|
@@2:
|
||||||
|
call p
|
||||||
|
mov ecx, resultlength
|
||||||
|
cmp ecx, 0
|
||||||
|
je @@5
|
||||||
|
cmp ecx, 1
|
||||||
|
je @@3
|
||||||
|
cmp ecx, 2
|
||||||
|
je @@4
|
||||||
|
mov r, eax
|
||||||
|
jmp @@5
|
||||||
|
@@3:
|
||||||
|
xor ecx, ecx
|
||||||
|
mov cl, al
|
||||||
|
mov r, ecx
|
||||||
|
jmp @@5
|
||||||
|
@@4:
|
||||||
|
xor ecx, ecx
|
||||||
|
mov cx, ax
|
||||||
|
mov r, ecx
|
||||||
|
@@5:
|
||||||
|
mov ecx, resedx
|
||||||
|
jecxz @@6
|
||||||
|
mov [ecx], edx
|
||||||
|
@@6:
|
||||||
|
end;
|
||||||
|
Result := r;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RealCall_CDecl(p: Pointer;
|
||||||
|
StackData: Pointer;
|
||||||
|
StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
|
||||||
|
ResultLength: Longint; ResEDX: Pointer): Longint; Stdcall; // make sure all things are on stack
|
||||||
|
var
|
||||||
|
r: Longint;
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
mov ecx, stackdatalen
|
||||||
|
jecxz @@2
|
||||||
|
mov eax, stackdata
|
||||||
|
@@1:
|
||||||
|
mov edx, [eax]
|
||||||
|
push edx
|
||||||
|
sub eax, 4
|
||||||
|
dec ecx
|
||||||
|
or ecx, ecx
|
||||||
|
jnz @@1
|
||||||
|
@@2:
|
||||||
|
call p
|
||||||
|
mov ecx, resultlength
|
||||||
|
cmp ecx, 0
|
||||||
|
je @@5
|
||||||
|
cmp ecx, 1
|
||||||
|
je @@3
|
||||||
|
cmp ecx, 2
|
||||||
|
je @@4
|
||||||
|
mov r, eax
|
||||||
|
jmp @@5
|
||||||
|
@@3:
|
||||||
|
xor ecx, ecx
|
||||||
|
mov cl, al
|
||||||
|
mov r, ecx
|
||||||
|
jmp @@5
|
||||||
|
@@4:
|
||||||
|
xor ecx, ecx
|
||||||
|
mov cx, ax
|
||||||
|
mov r, ecx
|
||||||
|
@@5:
|
||||||
|
mov ecx, stackdatalen
|
||||||
|
jecxz @@7
|
||||||
|
@@6:
|
||||||
|
pop eax
|
||||||
|
dec ecx
|
||||||
|
or ecx, ecx
|
||||||
|
jnz @@6
|
||||||
|
mov ecx, resedx
|
||||||
|
jecxz @@7
|
||||||
|
mov [ecx], edx
|
||||||
|
@@7:
|
||||||
|
end;
|
||||||
|
Result := r;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
EmptyPchar: array[0..0] of char = #0;
|
||||||
|
|
||||||
|
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
|
||||||
|
var
|
||||||
|
Stack: ansistring;
|
||||||
|
I: Longint;
|
||||||
|
RegUsage: Byte;
|
||||||
|
CallData: TPSList;
|
||||||
|
pp: ^Byte;
|
||||||
|
IsConstructor: Boolean;
|
||||||
|
|
||||||
|
EAX, EDX, ECX: Longint;
|
||||||
|
|
||||||
|
function rp(p: PPSVariantIFC): PPSVariantIFC;
|
||||||
|
begin
|
||||||
|
if p = nil then
|
||||||
|
begin
|
||||||
|
result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if p.aType.BaseType = btPointer then
|
||||||
|
begin
|
||||||
|
p^.aType := Pointer(Pointer(IPointer(p^.dta) + 4)^);
|
||||||
|
p^.Dta := Pointer(p^.dta^);
|
||||||
|
end;
|
||||||
|
Result := p;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetPtr(fVar: PPSVariantIFC): Boolean;
|
||||||
|
var
|
||||||
|
varPtr: Pointer;
|
||||||
|
UseReg: Boolean;
|
||||||
|
tempstr: tbtstring;
|
||||||
|
p: Pointer;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if FVar = nil then exit;
|
||||||
|
if fVar.VarParam then
|
||||||
|
begin
|
||||||
|
case fvar.aType.BaseType of
|
||||||
|
btArray:
|
||||||
|
begin
|
||||||
|
if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then
|
||||||
|
begin
|
||||||
|
p := CreateOpenArray(True, Self, FVar);
|
||||||
|
if p = nil then exit;
|
||||||
|
CallData.Add(p);
|
||||||
|
case RegUsage of
|
||||||
|
0: begin EAX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
||||||
|
1: begin EDX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
||||||
|
2: begin ECX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
||||||
|
else begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
||||||
|
Pointer((@Stack[1])^) := POpenArray(p)^.Data;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
case RegUsage of
|
||||||
|
0: begin EAX := Longint(POpenArray(p)^.ItemCount - 1); Inc(RegUsage); end;
|
||||||
|
1: begin EDX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
||||||
|
2: begin ECX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
||||||
|
else begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
||||||
|
Longint((@Stack[1])^) := POpenArray(p)^.ItemCount -1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
Exit;
|
||||||
|
end else begin
|
||||||
|
{$IFDEF PS_DYNARRAY}
|
||||||
|
varptr := fvar.Dta;
|
||||||
|
{$ELSE}
|
||||||
|
Exit;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
btVariant,
|
||||||
|
btSet,
|
||||||
|
btStaticArray,
|
||||||
|
btRecord,
|
||||||
|
btInterface,
|
||||||
|
btClass,
|
||||||
|
{$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16,
|
||||||
|
btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
|
||||||
|
{$IFNDEF PS_NOINT64}, bts64{$ENDIF}:
|
||||||
|
begin
|
||||||
|
Varptr := fvar.Dta;
|
||||||
|
end;
|
||||||
|
else begin
|
||||||
|
exit; //invalid type
|
||||||
|
end;
|
||||||
|
end; {case}
|
||||||
|
case RegUsage of
|
||||||
|
0: begin EAX := Longint(VarPtr); Inc(RegUsage); end;
|
||||||
|
1: begin EDX := Longint(VarPtr); Inc(RegUsage); end;
|
||||||
|
2: begin ECX := Longint(VarPtr); Inc(RegUsage); end;
|
||||||
|
else begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
||||||
|
Pointer((@Stack[1])^) := VarPtr;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
UseReg := True;
|
||||||
|
case fVar^.aType.BaseType of
|
||||||
|
btSet:
|
||||||
|
begin
|
||||||
|
tempstr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
case TPSTypeRec_Set(fvar.aType).aByteSize of
|
||||||
|
1: Byte((@tempstr[1])^) := byte(fvar.dta^);
|
||||||
|
2: word((@tempstr[1])^) := word(fvar.dta^);
|
||||||
|
3, 4: cardinal((@tempstr[1])^) := cardinal(fvar.dta^);
|
||||||
|
else
|
||||||
|
pointer((@tempstr[1])^) := fvar.dta;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
btArray:
|
||||||
|
begin
|
||||||
|
if Copy(fvar^.aType.ExportName, 1, 10) = '!OPENARRAY' then
|
||||||
|
begin
|
||||||
|
p := CreateOpenArray(False, SElf, FVar);
|
||||||
|
if p =nil then exit;
|
||||||
|
CallData.Add(p);
|
||||||
|
case RegUsage of
|
||||||
|
0: begin EAX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
||||||
|
1: begin EDX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
||||||
|
2: begin ECX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
||||||
|
else begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
||||||
|
Pointer((@Stack[1])^) := POpenArray(p)^.Data;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
case RegUsage of
|
||||||
|
0: begin EAX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
||||||
|
1: begin EDX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
||||||
|
2: begin ECX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
||||||
|
else begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
||||||
|
Longint((@Stack[1])^) := POpenArray(p)^.ItemCount -1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
exit;
|
||||||
|
end else begin
|
||||||
|
{$IFDEF PS_DYNARRAY}
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
Pointer((@TempStr[1])^) := Pointer(fvar.Dta^);
|
||||||
|
{$IFDEF PS_ARRAY_ON_STACK}
|
||||||
|
UseReg := false;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ELSE}
|
||||||
|
Exit;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
btVariant
|
||||||
|
, btStaticArray, btRecord:
|
||||||
|
begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
Pointer((@TempStr[1])^) := Pointer(fvar.Dta);
|
||||||
|
end;
|
||||||
|
btDouble: {8 bytes} begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),8);
|
||||||
|
UseReg := False;
|
||||||
|
double((@TempStr[1])^) := double(fvar.dta^);
|
||||||
|
end;
|
||||||
|
btCurrency: {8 bytes} begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),8);
|
||||||
|
UseReg := False;
|
||||||
|
currency((@TempStr[1])^) := currency(fvar.dta^);
|
||||||
|
end;
|
||||||
|
btSingle: {4 bytes} begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);;
|
||||||
|
UseReg := False;
|
||||||
|
Single((@TempStr[1])^) := single(fvar.dta^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
btExtended: {10 bytes} begin
|
||||||
|
UseReg := False;
|
||||||
|
TempStr:= StringOfChar(AnsiChar(#0),12);
|
||||||
|
Extended((@TempStr[1])^) := extended(fvar.dta^);
|
||||||
|
end;
|
||||||
|
btChar,
|
||||||
|
btU8,
|
||||||
|
btS8: begin
|
||||||
|
TempStr := tbtchar(fVar^.dta^) + tbtstring(StringOfChar(AnsiChar(#0),3));
|
||||||
|
end;
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}
|
||||||
|
btu16, btS16: begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
Word((@TempStr[1])^) := word(fVar^.dta^);
|
||||||
|
end;
|
||||||
|
btu32, bts32: begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
Longint((@TempStr[1])^) := Longint(fVar^.dta^);
|
||||||
|
end;
|
||||||
|
btPchar:
|
||||||
|
begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
if pointer(fvar^.dta^) = nil then
|
||||||
|
Pointer((@TempStr[1])^) := @EmptyPchar
|
||||||
|
else
|
||||||
|
Pointer((@TempStr[1])^) := pointer(fvar^.dta^);
|
||||||
|
end;
|
||||||
|
btclass, btinterface, btString:
|
||||||
|
begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
Pointer((@TempStr[1])^) := pointer(fvar^.dta^);
|
||||||
|
end;
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}
|
||||||
|
btWideString: begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
Pointer((@TempStr[1])^) := pointer(fvar^.dta^);
|
||||||
|
end;
|
||||||
|
btUnicodeString: begin
|
||||||
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
||||||
|
Pointer((@TempStr[1])^) := pointer(fvar^.dta^);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
btProcPtr:
|
||||||
|
begin
|
||||||
|
tempstr := StringOfChar(AnsiChar(#0),8);
|
||||||
|
TMethod((@TempStr[1])^) := MKMethod(Self, Longint(FVar.Dta^));
|
||||||
|
UseReg := false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF PS_NOINT64}bts64:
|
||||||
|
begin
|
||||||
|
TempStr:= StringOfChar(AnsiChar(#0),8);
|
||||||
|
Int64((@TempStr[1])^) := int64(fvar^.dta^);
|
||||||
|
UseReg := False;
|
||||||
|
end;{$ENDIF}
|
||||||
|
end; {case}
|
||||||
|
if UseReg then
|
||||||
|
begin
|
||||||
|
case RegUsage of
|
||||||
|
0: begin EAX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
|
||||||
|
1: begin EDX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
|
||||||
|
2: begin ECX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
|
||||||
|
else begin
|
||||||
|
{$IFDEF FPC_OLD_FIX}
|
||||||
|
if CallingConv = cdRegister then
|
||||||
|
Stack := Stack + TempStr
|
||||||
|
else
|
||||||
|
{$ENDIF}
|
||||||
|
Stack := TempStr + Stack;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
{$IFDEF FPC_OLD_FIX}
|
||||||
|
if CallingConv = cdRegister then
|
||||||
|
Stack := Stack + TempStr
|
||||||
|
else
|
||||||
|
{$ENDIF}
|
||||||
|
Stack := TempStr + Stack;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
if (Integer(CallingConv) and 64) <> 0 then begin
|
||||||
|
IsConstructor := true;
|
||||||
|
CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 64);
|
||||||
|
end else IsConstructor := false;
|
||||||
|
|
||||||
|
InnerfuseCall := False;
|
||||||
|
if Address = nil then
|
||||||
|
exit; // need address
|
||||||
|
Stack := '';
|
||||||
|
CallData := TPSList.Create;
|
||||||
|
res := rp(res);
|
||||||
|
if res <> nil then
|
||||||
|
res.VarParam := true;
|
||||||
|
try
|
||||||
|
case CallingConv of
|
||||||
|
cdRegister: begin
|
||||||
|
EAX := 0;
|
||||||
|
EDX := 0;
|
||||||
|
ECX := 0;
|
||||||
|
RegUsage := 0;
|
||||||
|
|
||||||
|
{$IFDEF FPC} // FIX FOR FPC constructor calls
|
||||||
|
if IsConstructor then begin
|
||||||
|
if not GetPtr(rp(Params[0])) then exit; // this goes first
|
||||||
|
RegUsage := 2;
|
||||||
|
EDX := Longint(_Self);
|
||||||
|
Params.Delete(0);
|
||||||
|
end else
|
||||||
|
{$ENDIF}
|
||||||
|
if assigned(_Self) then begin
|
||||||
|
RegUsage := 1;
|
||||||
|
EAX := Longint(_Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
for I := 0 to Params.Count - 1 do
|
||||||
|
begin
|
||||||
|
if not GetPtr(rp(Params[I])) then Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if assigned(res) then begin
|
||||||
|
case res^.aType.BaseType of
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}btWideString, btUnicodeString, {$ENDIF}
|
||||||
|
btInterface, btArray, btrecord, {$IFNDEF PS_FPCSTRINGWORKAROUND}btstring, {$ENDIF}btVariant, btStaticArray: GetPtr(res);
|
||||||
|
btSet:
|
||||||
|
begin
|
||||||
|
if TPSTypeRec_Set(res.aType).aByteSize >4 then GetPtr(res);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
case res^.aType.BaseType of
|
||||||
|
btSet:
|
||||||
|
begin
|
||||||
|
case TPSTypeRec_Set(res.aType).aByteSize of
|
||||||
|
1: byte(res.Dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
||||||
|
2: word(res.Dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
||||||
|
3,
|
||||||
|
4: Longint(res.Dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
||||||
|
else RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil)
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
btSingle: tbtsingle(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btDouble: tbtdouble(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btExtended: tbtextended(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btchar,btU8, btS8: tbtu8(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
||||||
|
btClass :
|
||||||
|
{$IFDEF FPC_OLD_FIX}
|
||||||
|
tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX,
|
||||||
|
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
|
||||||
|
{$ELSE}
|
||||||
|
tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX,
|
||||||
|
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
btu32,bts32: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
||||||
|
btPChar: pansichar(res.dta^) := Pansichar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
||||||
|
{$IFNDEF PS_NOINT64}bts64:
|
||||||
|
begin
|
||||||
|
EAX := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
|
||||||
|
tbts64(res.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
btCurrency: tbtCurrency(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4) / 10000;
|
||||||
|
btInterface,
|
||||||
|
btVariant,
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}btWidestring,btUnicodestring, {$ENDIF}
|
||||||
|
btStaticArray, btArray, btrecord{$IFNDEF PS_FPCSTRINGWORKAROUND}, btstring {$ENDIF}: RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
||||||
|
{$IFDEF PS_FPCSTRINGWORKAROUND}
|
||||||
|
btstring: begin
|
||||||
|
eax := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
||||||
|
Longint(res.dta^) := eax;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
else
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
cdPascal: begin
|
||||||
|
RegUsage := 3;
|
||||||
|
for I := 0 to Params.Count - 1 do begin
|
||||||
|
if not GetPtr(Params[i]) then Exit;
|
||||||
|
end;
|
||||||
|
if assigned(res) then begin
|
||||||
|
case res^.aType.BaseType of
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}btWideString, btUnicodeString, {$ENDIF}btInterface, btArray, btrecord, btstring, btVariant: GetPtr(res);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if assigned(_Self) then begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4) +Stack;
|
||||||
|
Pointer((@Stack[1])^) := _Self;
|
||||||
|
end;
|
||||||
|
if assigned(res) then begin
|
||||||
|
case res^.aType.BaseType of
|
||||||
|
btSingle: tbtsingle(res^.Dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btDouble: tbtdouble(res^.Dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btExtended: tbtextended(res^.Dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btChar, btU8, btS8: tbtu8(res^.Dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.Dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
||||||
|
btClass, btu32, bts32: tbtu32(res^.Dta^):= RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
||||||
|
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
||||||
|
{$IFNDEF PS_NOINT64}bts64:
|
||||||
|
begin
|
||||||
|
EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
|
||||||
|
tbts64(res^.dta^) := Int64(EAX) shl 32 or EDX;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
btVariant,
|
||||||
|
btInterface, btrecord, btstring: RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
||||||
|
else
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
cdSafeCall: begin
|
||||||
|
RegUsage := 3;
|
||||||
|
if assigned(res) then begin
|
||||||
|
GetPtr(res);
|
||||||
|
end;
|
||||||
|
for I := Params.Count - 1 downto 0 do begin
|
||||||
|
if not GetPtr(Params[i]) then Exit;
|
||||||
|
end;
|
||||||
|
if assigned(_Self) then begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4) +Stack;
|
||||||
|
Pointer((@Stack[1])^) := _Self;
|
||||||
|
end;
|
||||||
|
OleCheck(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CdCdecl: begin
|
||||||
|
RegUsage := 3;
|
||||||
|
if assigned(_Self) then begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4);
|
||||||
|
Pointer((@Stack[1])^) := _Self;
|
||||||
|
end;
|
||||||
|
for I := Params.Count - 1 downto 0 do begin
|
||||||
|
if not GetPtr(Params[I]) then Exit;
|
||||||
|
end;
|
||||||
|
if assigned(res) then begin
|
||||||
|
case res^.aType.BaseType of
|
||||||
|
btSingle: tbtsingle(res^.dta^) := RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btDouble: tbtdouble(res^.dta^) := RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btExtended: tbtextended(res^.dta^) := RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btCHar, btU8, btS8: tbtu8(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
||||||
|
btClass, btu32, bts32: tbtu32(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
||||||
|
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
||||||
|
{$IFNDEF PS_NOINT64}bts64:
|
||||||
|
begin
|
||||||
|
EAX := RealCall_CDecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
|
||||||
|
tbts64(res^.Dta^) := Int64(EAX) shl 32 or EDX;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
btVariant, {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, {$ENDIF}
|
||||||
|
btInterface,
|
||||||
|
btArray, btrecord, btstring: begin GetPtr(res); RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil); end;
|
||||||
|
else
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
RealCall_CDecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
CdStdCall: begin
|
||||||
|
RegUsage := 3;
|
||||||
|
for I := Params.Count - 1 downto 0 do begin
|
||||||
|
if not GetPtr(Params[I]) then exit;
|
||||||
|
end;
|
||||||
|
if assigned(_Self) then begin
|
||||||
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
||||||
|
Pointer((@Stack[1])^) := _Self;
|
||||||
|
end;
|
||||||
|
if assigned(res) then begin
|
||||||
|
case res^.aType.BaseType of
|
||||||
|
btSingle: tbtsingle(res^.dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btDouble: tbtdouble(res^.dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btExtended: tbtextended(res^.dta^):= RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
||||||
|
btChar, btU8, btS8: tbtu8(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
||||||
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
||||||
|
btclass, btu32, bts32: tbtu32(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
||||||
|
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
||||||
|
{$IFNDEF PS_NOINT64}bts64:
|
||||||
|
begin
|
||||||
|
EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
|
||||||
|
tbts64(res^.dta^) := Int64(EAX) shl 32 or EDX;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
btVariant, {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, {$ENDIF}
|
||||||
|
btInterface, btArray, btrecord, btstring: begin GetPtr(res); RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil); end;
|
||||||
|
else
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
for i := CallData.Count -1 downto 0 do
|
||||||
|
begin
|
||||||
|
pp := CallData[i];
|
||||||
|
case pp^ of
|
||||||
|
0: DestroyOpenArray(Self, Pointer(pp));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
CallData.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user