moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-02-11 21:00:13 -05:00
Code Issues Releases Wiki Activity

Tell me if I missed anything.

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@125 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-10-12 15:04:52 +00:00
parent bd5f01d4c0
commit 6c1938cc7f
18 changed files with 2080 additions and 1856 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
Projects/SAMufasaGUI/project1.lpi
View File

@ -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="4"/> <ActiveEditorIndexAtStart Value="10"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
@ -38,7 +38,7 @@
<Filename Value="project1.lpr"/> <Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="project1"/> <UnitName Value="project1"/>
<CursorPos X="71" Y="10"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="191"/> <UsageCount Value="191"/>
@ -170,11 +170,9 @@
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="TestUnit"/> <UnitName Value="TestUnit"/>
<CursorPos X="111" Y="8"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="13"/>
<UsageCount Value="157"/> <UsageCount Value="157"/>
<Loaded Value="True"/>
</Unit18> </Unit18>
<Unit19> <Unit19>
<Filename Value="../cogat/Units/CogatUnits/compcolors.pas"/> <Filename Value="../cogat/Units/CogatUnits/compcolors.pas"/>
@ -302,7 +300,7 @@
<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="47" Y="3"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="4"/> <EditorIndex Value="4"/>
<UsageCount Value="156"/> <UsageCount Value="156"/>
@ -392,8 +390,8 @@
<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="10" Y="62"/> <CursorPos X="63" Y="64"/>
<TopLine Value="50"/> <TopLine Value="52"/>
<UsageCount Value="147"/> <UsageCount Value="147"/>
</Unit48> </Unit48>
<Unit49> <Unit49>
@ -406,8 +404,8 @@
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="mmlpsthread"/> <UnitName Value="mmlpsthread"/>
<CursorPos X="31" Y="135"/> <CursorPos X="47" Y="11"/>
<TopLine Value="117"/> <TopLine Value="1"/>
<EditorIndex Value="9"/> <EditorIndex Value="9"/>
<UsageCount Value="145"/> <UsageCount Value="145"/>
<Loaded Value="True"/> <Loaded Value="True"/>
@ -517,11 +515,9 @@
</Unit65> </Unit65>
<Unit66> <Unit66>
<Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/>
<CursorPos X="42" Y="79"/> <CursorPos X="51" Y="18"/>
<TopLine Value="48"/> <TopLine Value="1"/>
<EditorIndex Value="11"/>
<UsageCount Value="46"/> <UsageCount Value="46"/>
<Loaded Value="True"/>
</Unit66> </Unit66>
<Unit67> <Unit67>
<Filename Value="../../../FPC/FPCCheckout/rtl/win/tthread.inc"/> <Filename Value="../../../FPC/FPCCheckout/rtl/win/tthread.inc"/>
@ -554,18 +550,16 @@
</Unit70> </Unit70>
<Unit71> <Unit71>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/colour.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/colour.inc"/>
<CursorPos X="86" Y="33"/> <CursorPos X="1" Y="1"/>
<TopLine Value="10"/> <TopLine Value="1"/>
<UsageCount Value="16"/> <UsageCount Value="16"/>
</Unit71> </Unit71>
<Unit72> <Unit72>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/bitmap.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/bitmap.inc"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<CursorPos X="26" Y="93"/> <CursorPos X="55" Y="24"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="10"/>
<UsageCount Value="134"/> <UsageCount Value="134"/>
<Loaded Value="True"/>
</Unit72> </Unit72>
<Unit73> <Unit73>
<Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.inc"/> <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.inc"/>
@ -712,13 +706,13 @@
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/mouse.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/mouse.inc"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="9"/> <UsageCount Value="10"/>
</Unit94> </Unit94>
<Unit95> <Unit95>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/>
<CursorPos X="1" Y="1"/> <CursorPos X="41" Y="15"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="8"/> <UsageCount Value="10"/>
</Unit95> </Unit95>
<Unit96> <Unit96>
<Filename Value="../../Units/PascalScript/uPSCompiler.pas"/> <Filename Value="../../Units/PascalScript/uPSCompiler.pas"/>
@ -756,8 +750,8 @@
<Filename Value="../../Units/MMLAddon/plugins.pas"/> <Filename Value="../../Units/MMLAddon/plugins.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="plugins"/> <UnitName Value="plugins"/>
<CursorPos X="86" Y="128"/> <CursorPos X="1" Y="1"/>
<TopLine Value="128"/> <TopLine Value="1"/>
<UsageCount Value="111"/> <UsageCount Value="111"/>
</Unit101> </Unit101>
<Unit102> <Unit102>
@ -790,7 +784,9 @@
<Filename Value="../../Units/MMLAddon/PSInc/psdefines.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/psdefines.inc"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="10"/>
<UsageCount Value="12"/> <UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit106> </Unit106>
<Unit107> <Unit107>
<Filename Value="../../Units/PascalScript/x86.inc"/> <Filename Value="../../Units/PascalScript/x86.inc"/>
@ -806,9 +802,9 @@
</Unit108> </Unit108>
<Unit109> <Unit109>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/math.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/math.inc"/>
<CursorPos X="10" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="7"/> <UsageCount Value="10"/>
</Unit109> </Unit109>
<Unit110> <Unit110>
<Filename Value="../../../lazarus/lcl/controls.pp"/> <Filename Value="../../../lazarus/lcl/controls.pp"/>
@ -865,11 +861,9 @@
<Filename Value="../../Units/MMLAddon/colourpicker.pas"/> <Filename Value="../../Units/MMLAddon/colourpicker.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="colourpicker"/> <UnitName Value="colourpicker"/>
<CursorPos X="53" Y="33"/> <CursorPos X="1" Y="1"/>
<TopLine Value="15"/> <TopLine Value="1"/>
<EditorIndex Value="12"/>
<UsageCount Value="88"/> <UsageCount Value="88"/>
<Loaded Value="True"/>
</Unit117> </Unit117>
<Unit118> <Unit118>
<Filename Value="../../../cogat/Units/CogatUnits/compdragger.pas"/> <Filename Value="../../../cogat/Units/CogatUnits/compdragger.pas"/>
@ -892,8 +886,8 @@
<Filename Value="../../Units/MMLAddon/windowselector.pas"/> <Filename Value="../../Units/MMLAddon/windowselector.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="windowselector"/> <UnitName Value="windowselector"/>
<CursorPos X="76" Y="83"/> <CursorPos X="1" Y="1"/>
<TopLine Value="65"/> <TopLine Value="1"/>
<UsageCount Value="78"/> <UsageCount Value="78"/>
</Unit120> </Unit120>
<Unit121> <Unit121>
@ -941,8 +935,8 @@
</Unit126> </Unit126>
<Unit127> <Unit127>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/dtm.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/dtm.inc"/>
<CursorPos X="2" Y="23"/> <CursorPos X="1" Y="1"/>
<TopLine Value="6"/> <TopLine Value="1"/>
<UsageCount Value="22"/> <UsageCount Value="22"/>
</Unit127> </Unit127>
<Unit128> <Unit128>
@ -996,127 +990,119 @@
<UsageCount Value="10"/> <UsageCount Value="10"/>
</Unit134> </Unit134>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="28" HistoryIndex="27">
<Position1> <Position1>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<Caret Line="11" Column="130" TopLine="1"/> <Caret Line="78" Column="129" TopLine="68"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<Caret Line="10" Column="112" TopLine="1"/> <Caret Line="270" Column="13" TopLine="242"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<Caret Line="8" Column="83" TopLine="1"/> <Caret Line="4" Column="116" TopLine="1"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="36" Column="43" TopLine="2"/> <Caret Line="36" Column="43" TopLine="2"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="57" Column="52" TopLine="16"/> <Caret Line="38" Column="90" TopLine="10"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="78" Column="129" TopLine="68"/> <Caret Line="579" Column="25" TopLine="542"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="270" Column="13" TopLine="242"/> <Caret Line="7" Column="132" TopLine="1"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="4" Column="116" TopLine="1"/> <Caret Line="124" Column="19" TopLine="96"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="36" Column="43" TopLine="2"/> <Caret Line="207" Column="19" TopLine="179"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="38" Column="90" TopLine="10"/> <Caret Line="582" Column="53" TopLine="543"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="579" Column="25" TopLine="542"/> <Caret Line="38" Column="53" TopLine="1"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="7" Column="132" TopLine="1"/> <Caret Line="570" Column="127" TopLine="527"/>
</Position12> </Position12>
<Position13> <Position13>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="124" Column="19" TopLine="96"/> <Caret Line="546" Column="51" TopLine="543"/>
</Position13> </Position13>
<Position14> <Position14>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="207" Column="19" TopLine="179"/> <Caret Line="540" Column="32" TopLine="525"/>
</Position14> </Position14>
<Position15> <Position15>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="582" Column="53" TopLine="543"/> <Caret Line="38" Column="68" TopLine="38"/>
</Position15> </Position15>
<Position16> <Position16>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="38" Column="53" TopLine="1"/> <Caret Line="540" Column="46" TopLine="525"/>
</Position16> </Position16>
<Position17> <Position17>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="570" Column="127" TopLine="527"/> <Caret Line="38" Column="46" TopLine="38"/>
</Position17> </Position17>
<Position18> <Position18>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="546" Column="51" TopLine="543"/> <Caret Line="10" Column="137" TopLine="1"/>
</Position18> </Position18>
<Position19> <Position19>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="540" Column="32" TopLine="525"/> <Caret Line="124" Column="19" TopLine="96"/>
</Position19> </Position19>
<Position20> <Position20>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="38" Column="68" TopLine="38"/> <Caret Line="135" Column="23" TopLine="120"/>
</Position20> </Position20>
<Position21> <Position21>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="540" Column="46" TopLine="525"/> <Caret Line="36" Column="1" TopLine="1"/>
</Position21> </Position21>
<Position22> <Position22>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="38" Column="46" TopLine="38"/> <Caret Line="8" Column="7" TopLine="1"/>
</Position22> </Position22>
<Position23> <Position23>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/client.pas"/>
<Caret Line="10" Column="137" TopLine="1"/> <Caret Line="23" Column="8" TopLine="1"/>
</Position23> </Position23>
<Position24> <Position24>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="124" Column="19" TopLine="96"/> <Caret Line="157" Column="22" TopLine="136"/>
</Position24> </Position24>
<Position25> <Position25>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="135" Column="23" TopLine="120"/> <Caret Line="159" Column="23" TopLine="136"/>
</Position25> </Position25>
<Position26> <Position26>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/bitmap.inc"/> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="108" Column="19" TopLine="61"/> <Caret Line="160" Column="22" TopLine="136"/>
</Position26> </Position26>
<Position27> <Position27>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="36" Column="1" TopLine="1"/> <Caret Line="161" Column="22" TopLine="136"/>
</Position27> </Position27>
<Position28> <Position28>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/bitmap.inc"/> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="114" Column="27" TopLine="77"/> <Caret Line="162" Column="21" TopLine="136"/>
</Position28> </Position28>
<Position29>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="8" Column="7" TopLine="1"/>
</Position29>
<Position30>
<Filename Value="../../Units/MMLCore/client.pas"/>
<Caret Line="23" Column="8" TopLine="1"/>
</Position30>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

23
Projects/SAMufasaGUI/project1.lpr
View File

@ -1,3 +1,26 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
SAMufasaGUI for the Mufasa Macro Library
}
program project1; program project1;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}

7
Projects/SAMufasaGUI/testunit.lfm
View File

@ -5,7 +5,7 @@ object Form1: TForm1
Width = 723 Width = 723
ActiveControl = SynEdit1 ActiveControl = SynEdit1
Caption = 'Mufasa v2' Caption = 'Mufasa v2'
ClientHeight = 533 ClientHeight = 528
ClientWidth = 723 ClientWidth = 723
Menu = MainMenu1 Menu = MainMenu1
OnCreate = FormCreate OnCreate = FormCreate
@ -25,8 +25,7 @@ object Form1: TForm1
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
BookMarkOptions.OnChange = nil Gutter.Width = 61
Gutter.Width = 57
Gutter.MouseActions = < Gutter.MouseActions = <
item item
Shift = [] Shift = []
@ -608,7 +607,7 @@ object Form1: TForm1
Width = 23 Width = 23
end end
object TSynGutterLineNumber object TSynGutterLineNumber
Width = 17 Width = 21
MouseActions = <> MouseActions = <>
MarkupInfo.Background = clBtnFace MarkupInfo.Background = clBtnFace
MarkupInfo.Foreground = clNone MarkupInfo.Foreground = clNone

1525
Projects/SAMufasaGUI/testunit.lrs
View File

File diff suppressed because it is too large Load Diff

23
Projects/SAMufasaGUI/testunit.pas
View File

@ -1,3 +1,26 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
TestUnit/GUI for the Mufasa Macro Library
}
unit TestUnit; unit TestUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}

317
Units/MMLAddon/PSInc/Wrappers/bitmap.inc
View File

@ -1,147 +1,170 @@
function CreateBitmap(w,h : integer):integer; {
begin This file is part of the Mufasa Macro Library (MML)
result := CurrThread.Client.MBitmaps.CreateBMP(w,h); Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
end;
MML is free software: you can redistribute it and/or modify
procedure FreeBitmap(Number : integer); it under the terms of the GNU General Public License as published by
begin the Free Software Foundation, either version 3 of the License, or
CurrThread.Client.MBitmaps.FreeBMP(Number); (at your option) any later version.
end;
MML is distributed in the hope that it will be useful,
procedure SaveBitmap(Bmp : integer; path : string); but WITHOUT ANY WARRANTY; without even the implied warranty of
begin; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
CurrThread.Client.MBitmaps.Bmp[Bmp].SaveToFile(Path); GNU General Public License for more details.
end;
You should have received a copy of the GNU General Public License
function BitmapFromString(Width,height : integer; Data : string) : integer; along with MML. If not, see <http://www.gnu.org/licenses/>.
begin;
Result := CurrThread.Client.MBitmaps.CreateBMPFromString(Width,Height,Data); See the file COPYING, included in this distribution,
end; for details about the copyright.
function LoadBitmap(Path : String) : integer; Bitmap.inc for the Mufasa Macro Library
begin; }
Result := CurrThread.Client.MBitmaps.CreateBMPFromFile(Path);
end; function CreateBitmap(w,h : integer):integer;
begin
procedure SetBitmapSize(Bmp,NewW,NewH : integer); result := CurrThread.Client.MBitmaps.CreateBMP(w,h);
begin; end;
if (NewW>=0) and (NewH >=0) then
CurrThread.Client.MBitmaps.Bmp[Bmp].SetSize(NewW,NewH); procedure FreeBitmap(Number : integer);
end; begin
CurrThread.Client.MBitmaps.FreeBMP(Number);
procedure GetBitmapSize(Bmp : integer; var BmpW,BmpH : integer); end;
begin;
With CurrThread.Client.MBitmaps.Bmp[bmp] do procedure SaveBitmap(Bmp : integer; path : string);
begin; begin;
BmpW := width; CurrThread.Client.MBitmaps.Bmp[Bmp].SaveToFile(Path);
BmpH := Height; end;
end;
end; function BitmapFromString(Width,height : integer; Data : string) : integer;
begin;
procedure SetBitmapName(Bmp : integer; name : string); Result := CurrThread.Client.MBitmaps.CreateBMPFromString(Width,Height,Data);
begin; end;
CurrThread.Client.MBitmaps.Bmp[Bmp].BmpName:= name;
end; function LoadBitmap(Path : String) : integer;
begin;
function CreateMirroredBitmap(Bmp : integer) : integer; Result := CurrThread.Client.MBitmaps.CreateBMPFromFile(Path);
begin; end;
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp, MirrorWidth);
end; procedure SetBitmapSize(Bmp,NewW,NewH : integer);
begin;
function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer; if (NewW>=0) and (NewH >=0) then
begin; CurrThread.Client.MBitmaps.Bmp[Bmp].SetSize(NewW,NewH);
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp,MirrorStyle); end;
end;
procedure GetBitmapSize(Bmp : integer; var BmpW,BmpH : integer);
function FastGetPixel(bmp,x,y : integer) : LongWord; begin;
begin; With CurrThread.Client.MBitmaps.Bmp[bmp] do
Result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixel(x,y); begin;
end; BmpW := width;
BmpH := Height;
function FastGetPixels(bmp : integer; TPA : TPointArray) : TIntegerArray; end;
begin; end;
result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixels(TPA);
end; procedure SetBitmapName(Bmp : integer; name : string);
begin;
procedure FastSetPixel(Bmp,x,y : integer; Color : TColor); CurrThread.Client.MBitmaps.Bmp[Bmp].BmpName:= name;
begin end;
CurrThread.Client.MBitmaps.Bmp[bmp].FastSetPixel(x,y,color);
end; function CreateMirroredBitmap(Bmp : integer) : integer;
begin;
procedure FastSetPixels(Bmp : integer; TPA : TPointArray; Colors : TIntegerArray); Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp, MirrorWidth);
begin; end;
CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors);
end; function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;
begin;
procedure FastDrawClear(bmp : integer; Color : TColor); Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp,MirrorStyle);
begin; end;
CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color);
end; function FastGetPixel(bmp,x,y : integer) : LongWord;
begin;
procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer); Result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixel(x,y);
begin; end;
CurrThread.Client.MBitmaps.Bmp[SourceBitmap].FastDrawTransparent(x,y,CurrThread.Client.MBitmaps.Bmp[TargetBitmap]);
end; function FastGetPixels(bmp : integer; TPA : TPointArray) : TIntegerArray;
begin;
procedure SetTransparentColor(Bmp : integer; Color : TColor); result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixels(TPA);
begin end;
CurrThread.Client.MBitmaps.Bmp[Bmp].SetTransparentColor(Color);
end; procedure FastSetPixel(Bmp,x,y : integer; Color : TColor);
begin
function GetTransparentColor(Bmp : integer) : TColor; CurrThread.Client.MBitmaps.Bmp[bmp].FastSetPixel(x,y,color);
begin; end;
Result := CurrThread.Client.MBitmaps.Bmp[bmp].GetTransparentColor;
end; procedure FastSetPixels(Bmp : integer; TPA : TPointArray; Colors : TIntegerArray);
begin;
procedure FastReplaceColor(bmp: Integer; OldColor, NewColor: TColor); CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors);
begin end;
CurrThread.Client.MBitmaps.Bmp[Bmp].FastReplaceColor(OldColor,NewColor);
end; procedure FastDrawClear(bmp : integer; Color : TColor);
begin;
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer); CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color);
var end;
mBMP: TMufasaBitmap;
begin procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);
mBMP := CurrThread.Client.MBitmaps.GetBMP(bmp); begin;
if mBMP = nil then CurrThread.Client.MBitmaps.Bmp[SourceBitmap].FastDrawTransparent(x,y,CurrThread.Client.MBitmaps.Bmp[TargetBitmap]);
exit; end;
mBMP.CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
end; procedure SetTransparentColor(Bmp : integer; Color : TColor);
begin
function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean; CurrThread.Client.MBitmaps.Bmp[Bmp].SetTransparentColor(Color);
begin; end;
with CurrThread.Client do
result := MFinder.FindBitmap( MBitmaps.Bmp[bitmap],x,y); function GetTransparentColor(Bmp : integer) : TColor;
end; begin;
Result := CurrThread.Client.MBitmaps.Bmp[bmp].GetTransparentColor;
function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; end;
begin;
with CurrThread.Client do procedure FastReplaceColor(bmp: Integer; OldColor, NewColor: TColor);
result := MFinder.FindBitmapIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye); begin
end; CurrThread.Client.MBitmaps.Bmp[Bmp].FastReplaceColor(OldColor,NewColor);
end;
function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
begin; procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
with CurrThread.Client do var
result := MFinder.FindBitmapToleranceIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance); mBMP: TMufasaBitmap;
end; begin
mBMP := CurrThread.Client.MBitmaps.GetBMP(bmp);
if mBMP = nil then
function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; exit;
begin; mBMP.CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
with CurrThread.Client do end;
result := MFinder.FindBitmapSpiral(Mbitmaps.bmp[bitmap],x,y,xs,ye,xe,ye);
end; function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean;
begin;
function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean; with CurrThread.Client do
begin; result := MFinder.FindBitmap( MBitmaps.Bmp[bitmap],x,y);
with CurrThread.Client do end;
result := MFinder.FindBitmapsSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,points,xs,ys,xe,ye,tolerance);
end; function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
begin;
function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean; with CurrThread.Client do
begin; result := MFinder.FindBitmapIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye);
with CurrThread.Client do end;
result := MFinder.FindBitmapSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
end; function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapToleranceIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
end;
function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapSpiral(Mbitmaps.bmp[bitmap],x,y,xs,ye,xe,ye);
end;
function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapsSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,points,xs,ys,xe,ye,tolerance);
end;
function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
end;

121
Units/MMLAddon/PSInc/Wrappers/colour.inc
View File

@ -1,49 +1,72 @@
function GetColor(x,y : integer) : TColor; {
begin; This file is part of the Mufasa Macro Library (MML)
Result := CurrThread.Client.MWindow.GetColor(x,y); Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
end;
MML is free software: you can redistribute it and/or modify
function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean; it under the terms of the GNU General Public License as published by
begin the Free Software Foundation, either version 3 of the License, or
Result := CurrThread.Client.MFinder.FindColor(x, y, color, x1, y1, x2, y2); (at your option) any later version.
end;
MML is distributed in the hope that it will be useful,
function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean; but WITHOUT ANY WARRANTY; without even the implied warranty of
begin MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
Result := CurrThread.Client.MFinder.FindColorTolerance(x, y, color, x1, y1, x2, y2, tol); GNU General Public License for more details.
end;
You should have received a copy of the GNU General Public License
function FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean; along with MML. If not, see <http://www.gnu.org/licenses/>.
begin
Result := CurrThread.Client.MFinder.FindColors(TPA, color, x1, y1, x2, y2); See the file COPYING, included in this distribution,
end; for details about the copyright.
procedure SetColorToleranceSpeed(cts: Integer); Colour.inc for the Mufasa Macro Library
begin }
CurrThread.Client.MFinder.SetToleranceSpeed(cts);
end; function GetColor(x,y : integer) : TColor;
begin;
function SimilarColors(Col1,Col2,Tol : integer) : boolean; Result := CurrThread.Client.MWindow.GetColor(x,y);
begin; end;
Result := CurrThread.Client.MFinder.SimilarColors(Col1,Col2,Tol);
end; function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;
begin
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer; Result := CurrThread.Client.MFinder.FindColor(x, y, color, x1, y1, x2, y2);
begin; end;
result := CurrThread.Client.MFinder.CountColorTolerance(color,xs,ys,xe,ye,tolerance);
end; function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;
begin
function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean; Result := CurrThread.Client.MFinder.FindColorTolerance(x, y, color, x1, y1, x2, y2, tol);
begin; end;
result := CurrThread.Client.MFinder.FindColorsTolerance(points,color,xs,ys,xe,ye,tolerance);
end; function FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
begin
function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean; Result := CurrThread.Client.MFinder.FindColors(TPA, color, x1, y1, x2, y2);
begin; end;
result := CurrThread.Client.MFinder.FindColorSpiral(x,y,color,xs,ys,xe,ye);
end; procedure SetColorToleranceSpeed(cts: Integer);
begin
function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean; CurrThread.Client.MFinder.SetToleranceSpeed(cts);
begin; end;
result := CurrThread.Client.MFinder.FindColorsSpiralTolerance(x,y,Points,color,xs,ys,xe,ye,tolerance);
end; function SimilarColors(Col1,Col2,Tol : integer) : boolean;
begin;
Result := CurrThread.Client.MFinder.SimilarColors(Col1,Col2,Tol);
end;
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
begin;
result := CurrThread.Client.MFinder.CountColorTolerance(color,xs,ys,xe,ye,tolerance);
end;
function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;
begin;
result := CurrThread.Client.MFinder.FindColorsTolerance(points,color,xs,ys,xe,ye,tolerance);
end;
function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;
begin;
result := CurrThread.Client.MFinder.FindColorSpiral(x,y,color,xs,ys,xe,ye);
end;
function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;
begin;
result := CurrThread.Client.MFinder.FindColorsSpiralTolerance(x,y,Points,color,xs,ys,xe,ye,tolerance);
end;

23
Units/MMLAddon/PSInc/Wrappers/dtm.inc
View File

@ -1,3 +1,26 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
DTM.inc for the Mufasa Macro Library
}
function ps_FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean; function ps_FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
begin begin
Result := CurrThread.Client.MDTM.FindDTM(DTM, x, y, x1, y1, x2, y2); Result := CurrThread.Client.MDTM.FindDTM(DTM, x, y, x1, y1, x2, y2);

31
Units/MMLAddon/PSInc/Wrappers/math.inc
View File

@ -1,4 +1,27 @@
function psSqr( e : extended) : extended; {
begin; This file is part of the Mufasa Macro Library (MML)
result := sqr(e); Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
end;
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Math.inc for the Mufasa Macro Library
}
function psSqr( e : extended) : extended;
begin;
result := sqr(e);
end;

23
Units/MMLAddon/PSInc/Wrappers/mouse.inc
View File

@ -1,3 +1,26 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Mouse.inc for the Mufasa Macro Library
}
procedure MoveMouse(x, y: integer); procedure MoveMouse(x, y: integer);
begin begin
CurrThread.Client.MInput.SetMousePos(X, Y); CurrThread.Client.MInput.SetMousePos(X, Y);

23
Units/MMLAddon/PSInc/Wrappers/other.inc
View File

@ -1,3 +1,26 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Other.inc for the Mufasa Macro Library
}
procedure GetClientDimensions(var w, h: integer); procedure GetClientDimensions(var w, h: integer);
begin begin
CurrThread.Client.MWindow.GetDimensions(w, h); CurrThread.Client.MWindow.GetDimensions(w, h);

190
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -1,84 +1,106 @@
{
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer'); This file is part of the Mufasa Macro Library (MML)
Sender.Comp.AddTypeS('TPointArray','Array of TPoint'); Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Sender.Comp.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;'); the Free Software Foundation, either version 3 of the License, or
Sender.Comp.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;'); (at your option) any later version.
Sender.Comp.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPointDefArray; end;');
Sender.Comp.AddTypeS('pDTM','record p: TPointArray; c, t, asz, ash: TIntegerArray; end'); MML is distributed in the hope that it will be useful,
Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended'); but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); GNU General Public License for more details.
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
You should have received a copy of the GNU General Public License
{ DTM } along with MML. If not, see <http://www.gnu.org/licenses/>.
Sender.AddFunction(@PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);'); See the file COPYING, included in this distribution,
Sender.AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; var dtm: pDTM): Boolean;'); for details about the copyright.
Sender.AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(Const DTM: pDTM): TDTM;');
Sender.AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(Const DTM: TDTM): pDTM;'); PSCompile.inc for the Mufasa Macro Library
Sender.AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;'); }
Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
Sender.AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;'); Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
Sender.AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; var p: TPointArray; x1, y1, x2, y2: Integer): Boolean;'); Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
Sender.AddFunction(@ps_FindDTMRotated, 'function FindDTMRotated(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: Extended): Boolean;'); Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.AddFunction(@ps_FindDTMsRotated, 'function FindDTMsRotated(DTM: Integer; var Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
Sender.AddFunction(@ps_addDTM, 'function AddDTM(d: TDTM): Integer;');
Sender.AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;'); Sender.Comp.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
Sender.Comp.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;');
{maths} Sender.Comp.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPointDefArray; end;');
sender.AddFunction(@power,'function pow(base,exponent : extended) : extended'); Sender.Comp.AddTypeS('pDTM','record p: TPointArray; c, t, asz, ash: TIntegerArray; end');
Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;'); Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended');
Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;'); Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;'); Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
Sender.AddFunction(@Freeze, 'function freeze:boolean;'); { DTM }
Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
Sender.AddFunction(@PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);');
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;'); Sender.AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; var dtm: pDTM): Boolean;');
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); Sender.AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(Const DTM: pDTM): TDTM;');
Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;'); Sender.AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(Const DTM: TDTM): pDTM;');
Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;'); Sender.AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean'); Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;'); Sender.AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;');
Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;'); Sender.AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; var p: TPointArray; x1, y1, x2, y2: Integer): Boolean;');
Sender.AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;'); Sender.AddFunction(@ps_FindDTMRotated, 'function FindDTMRotated(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: Extended): Boolean;');
Sender.AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;'); Sender.AddFunction(@ps_FindDTMsRotated, 'function FindDTMsRotated(DTM: Integer; var Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
Sender.AddFunction(@ps_addDTM, 'function AddDTM(d: TDTM): Integer;');
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);'); Sender.AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;');
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
{maths}
Sender.AddFunction(@Wait, 'procedure wait(t: integer);'); sender.AddFunction(@power,'function pow(base,exponent : extended) : extended');
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);'); Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;');
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);'); Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;'); Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);'); Sender.AddFunction(@Freeze, 'function freeze:boolean;');
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);'); Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;'); Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);'); Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);'); Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;'); Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;'); Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);'); Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);'); Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;'); Sender.AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;');
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;'); Sender.AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);'); Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);'); Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);'); Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
Sender.AddFunction(@ps_CopyClientToBitmap, 'procedure CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);'); Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
Sender.AddFunction(@SetBitmapName, 'procedure SetBitmapName(Bmp : integer; name : string);'); Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
Sender.AddFunction(@FindBitmap,'function FindBitmap(bitmap: integer; var x, y: Integer): Boolean;'); Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
Sender.AddFunction(@FindBitmapIn,'function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
sender.AddFunction(@FindBitmapToleranceIn,'function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;'); Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
Sender.AddFunction(@FindBitmapSpiral,'function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;'); Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
Sender.AddFunction(@FindBitmapsSpiralTolerance,'function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;'); Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
Sender.AddFunction(@FindBitmapSpiralTolerance,'function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;'); Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
Sender.AddFunction(@ps_CopyClientToBitmap, 'procedure CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);');
Sender.AddFunction(@SetBitmapName, 'procedure SetBitmapName(Bmp : integer; name : string);');
Sender.AddFunction(@FindBitmap,'function FindBitmap(bitmap: integer; var x, y: Integer): Boolean;');
Sender.AddFunction(@FindBitmapIn,'function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
sender.AddFunction(@FindBitmapToleranceIn,'function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapSpiral,'function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
Sender.AddFunction(@FindBitmapsSpiralTolerance,'function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapSpiralTolerance,'function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;');

51
Units/MMLAddon/PSInc/psdefines.inc
View File

@ -1,14 +1,37 @@
{$IFDEF CPU386 } {
PSScript.Defines.Add('CPU386'); This file is part of the Mufasa Macro Library (MML)
{$ENDIF } Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
PSScript.Defines.Add('MUFASA');
PSScript.Defines.Add('COGAT'); MML is free software: you can redistribute it and/or modify
PSScript.Defines.Add('RAYMONDPOWNS'); it under the terms of the GNU General Public License as published by
{$IFDEF MSWINDOWS } the Free Software Foundation, either version 3 of the License, or
PSScript.Defines.Add('MSWINDOWS'); (at your option) any later version.
PSScript.Defines.Add('WIN32');
PSScript.Defines.Add('WINDOWS'); MML is distributed in the hope that it will be useful,
{$ENDIF } but WITHOUT ANY WARRANTY; without even the implied warranty of
{$IFDEF LINUX } MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
PSScript.Defines.Add('LINUX'); GNU General Public License for more details.
{$ENDIF }
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
PSDefines.inc for the Mufasa Macro Library
}
{$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 }

23
Units/MMLAddon/colourpicker.pas
View File

@ -1,3 +1,26 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Colourpicker for the Mufasa Macro Library
}
unit colourpicker; unit colourpicker;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}

587
Units/MMLAddon/mmlpsthread.pas
View File

@ -1,282 +1,305 @@
unit mmlpsthread; {
This file is part of the Mufasa Macro Library (MML)
{$mode objfpc}{$H+} Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
interface MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
uses the Free Software Foundation, either version 3 of the License, or
Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, uPSPreProcessor; (at your option) any later version.
type MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
{ TMMLPSThread } MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
TMMLPSThread = class(TThread)
procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor; You should have received a copy of the GNU General Public License
Parser: TPSPascalPreProcessorParser; const Active: Boolean; along with MML. If not, see <http://www.gnu.org/licenses/>.
const DirectiveName, DirectiveParam: string; var Continue: Boolean);
protected See the file COPYING, included in this distribution,
DebugTo : TMemo; for details about the copyright.
PluginsToload : Array of integer;
procedure OnCompile(Sender: TPSScript); MMLPSThread for the Mufasa Macro Library
procedure AfterExecute(Sender : TPSScript); }
function RequireFile(Sender: TObject; const OriginFileName: String;
var FileName, OutPut: string): Boolean; unit mmlpsthread;
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); {$mode objfpc}{$H+}
procedure OutputMessages;
procedure OnThreadTerminate(Sender: TObject); interface
procedure Execute; override;
public uses
PSScript : TPSScript; // Moved to public, as we can't kill it otherwise. Classes, SysUtils, client, uPSComponent,uPSCompiler,uPSRuntime,stdCtrls, uPSPreProcessor;
Client : TClient;
procedure SetPSScript(Script : string); type
procedure SetDebug( Strings : TMemo );
constructor Create(CreateSuspended: Boolean); { TMMLPSThread }
destructor Destroy; override;
end; TMMLPSThread = class(TThread)
procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
implementation Parser: TPSPascalPreProcessorParser; const Active: Boolean;
uses const DirectiveName, DirectiveParam: string; var Continue: Boolean);
MufasaTypes, dtmutil, protected
{$ifdef mswindows}windows,{$endif} DebugTo : TMemo;
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, PluginsToload : Array of integer;
uPSC_extctrls, //Compile-libs procedure OnCompile(Sender: TPSScript);
procedure AfterExecute(Sender : TPSScript);
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, function RequireFile(Sender: TObject; const OriginFileName: String;
uPSR_extctrls, //Runtime-libs var FileName, OutPut: string): Boolean;
Graphics, //For Graphics types procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
math, //Maths! procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
bitmaps, procedure OutputMessages;
lclintf; // for GetTickCount and others. procedure OnThreadTerminate(Sender: TObject);
procedure Execute; override;
public
threadvar PSScript : TPSScript; // Moved to public, as we can't kill it otherwise.
CurrThread : TMMLPSThread; Client : TClient;
procedure SetPSScript(Script : string);
{Some General PS Functions here} procedure SetDebug( Strings : TMemo );
procedure psWriteln(str : string); constructor Create(CreateSuspended: Boolean);
begin destructor Destroy; override;
{$IFNDEF MSWINDOWS} end;
writeln(str);
{$ELSE} implementation
if CurrThread.DebugTo <> nil then uses
CurrThread.DebugTo.lines.add(str); MufasaTypes, dtmutil,
{$ENDIF} {$ifdef mswindows}windows,{$endif}
end; uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,
uPSC_extctrls, //Compile-libs
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
begin; uPSR_extctrls, //Runtime-libs
Writeln('We have a length of: ' + inttostr(length(v))); Graphics, //For Graphics types
Try math, //Maths!
Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname)); bitmaps,
Except lclintf; // for GetTickCount and others.
Writeln('We has some errors :-(');
end;
end; threadvar
CurrThread : TMMLPSThread;
{ {Some General PS Functions here}
Note to Raymond: For PascalScript, Create it on the .Create, procedure psWriteln(str : string);
Execute it on the .Execute, and don't forget to Destroy it on .Destroy. begin
{$IFNDEF MSWINDOWS}
Furthermore, all the wrappers can be in the unit "implementation" section. writeln(str);
Better still to create an .inc for it, otherwise this unit will become huge. {$ELSE}
(You can even split up the .inc's in stuff like color, bitmap, etc. ) if CurrThread.DebugTo <> nil then
CurrThread.DebugTo.lines.add(str);
Also, don't add PS to this unit, but make a seperate unit for it. {$ENDIF}
Unit "MMLPSThread", perhaps? end;
See the TestUnit for use of this thread, it's pretty straightforward. function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;
It may also be wise to turn the "Importing of wrappers" into an include as begin;
well, it will really make the unit more straightforward to use and read. Writeln('We have a length of: ' + inttostr(length(v)));
} Try
Result := CurrThread.PSScript.Exec.RunProcPVar(v,CurrThread.PSScript.Exec.GetProc(Procname));
Except
constructor TMMLPSThread.Create(CreateSuspended : boolean); Writeln('We has some errors :-(');
begin end;
SetLength(PluginsToLoad,0); end;
Client := TClient.Create;
PSScript := TPSScript.Create(nil);
PSScript.UsePreProcessor:= True; {
PSScript.OnNeedFile := @RequireFile; Note to Raymond: For PascalScript, Create it on the .Create,
PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknowDirective; Execute it on the .Execute, and don't forget to Destroy it on .Destroy.
PSScript.OnCompile:= @OnCompile;
PSScript.OnCompImport:= @OnCompImport; Furthermore, all the wrappers can be in the unit "implementation" section.
PSScript.OnExecImport:= @OnExecImport; Better still to create an .inc for it, otherwise this unit will become huge.
PSScript.OnAfterExecute:= @AfterExecute; (You can even split up the .inc's in stuff like color, bitmap, etc. )
// Set some defines Also, don't add PS to this unit, but make a seperate unit for it.
{$I PSInc/psdefines.inc} Unit "MMLPSThread", perhaps?
See the TestUnit for use of this thread, it's pretty straightforward.
FreeOnTerminate := True;
Self.OnTerminate := @Self.OnThreadTerminate; It may also be wise to turn the "Importing of wrappers" into an include as
inherited Create(CreateSuspended); well, it will really make the unit more straightforward to use and read.
end; }
procedure TMMLPSThread.OnThreadTerminate(Sender: TObject);
begin constructor TMMLPSThread.Create(CreateSuspended : boolean);
// Writeln('Terminating the thread'); begin
end; SetLength(PluginsToLoad,0);
Client := TClient.Create;
destructor TMMLPSThread.Destroy; PSScript := TPSScript.Create(nil);
begin PSScript.UsePreProcessor:= True;
SetLength(PluginsToLoad,0); PSScript.OnNeedFile := @RequireFile;
Client.Free; PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknowDirective;
PSScript.Free; PSScript.OnCompile:= @OnCompile;
inherited; PSScript.OnCompImport:= @OnCompImport;
end; PSScript.OnExecImport:= @OnExecImport;
PSScript.OnAfterExecute:= @AfterExecute;
// include PS wrappers
{$I PSInc/Wrappers/other.inc} // Set some defines
{$I PSInc/Wrappers/bitmap.inc} {$I PSInc/psdefines.inc}
{$I PSInc/Wrappers/colour.inc}
{$I PSInc/Wrappers/math.inc}
{$I PSInc/Wrappers/mouse.inc} FreeOnTerminate := True;
{$I PSInc/Wrappers/dtm.inc} Self.OnTerminate := @Self.OnThreadTerminate;
inherited Create(CreateSuspended);
end;
procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor; procedure TMMLPSThread.OnThreadTerminate(Sender: TObject);
Parser: TPSPascalPreProcessorParser; const Active: Boolean; begin
const DirectiveName, DirectiveParam: string; var Continue: Boolean); // Writeln('Terminating the thread');
var end;
TempNum : integer;
I: integer; destructor TMMLPSThread.Destroy;
begin begin
if DirectiveName= 'LOADDLL' then SetLength(PluginsToLoad,0);
if DirectiveParam <> '' then Client.Free;
begin; PSScript.Free;
TempNum := PluginsGlob.LoadPlugin(DirectiveParam); inherited;
if TempNum < 0 then end;
Writeln(Format('Your DLL %s has not been found',[DirectiveParam]))
else // include PS wrappers
begin; {$I PSInc/Wrappers/other.inc}
for i := High(PluginsToLoad) downto 0 do {$I PSInc/Wrappers/bitmap.inc}
if PluginsToLoad[i] = TempNum then {$I PSInc/Wrappers/colour.inc}
Exit; {$I PSInc/Wrappers/math.inc}
SetLength(PluginsToLoad,Length(PluginsToLoad)+1); {$I PSInc/Wrappers/mouse.inc}
PluginsToLoad[High(PluginsToLoad)] := TempNum; {$I PSInc/Wrappers/dtm.inc}
end;
end;
Continue:= True;
end; procedure TMMLPSThread.PSScriptProcessUnknowDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
procedure TMMLPSThread.OnCompile(Sender: TPSScript); const DirectiveName, DirectiveParam: string; var Continue: Boolean);
var var
i,ii : integer; TempNum : integer;
begin I: integer;
for i := high(PluginsToLoad) downto 0 do begin
for ii := 0 to PluginsGlob.MPlugins[PluginsToLoad[i]].MethodLen - 1 do if DirectiveName= 'LOADDLL' then
PSScript.AddFunctionEx(PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[i].FuncPtr, if DirectiveParam <> '' then
PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[i].FuncStr, cdStdCall); begin;
// Here we add all the functions to the engine. TempNum := PluginsGlob.LoadPlugin(DirectiveParam);
{$I PSInc/pscompile.inc} if TempNum < 0 then
end; Writeln(Format('Your DLL %s has not been found',[DirectiveParam]))
else
procedure TMMLPSThread.AfterExecute(Sender: TPSScript); begin;
begin for i := High(PluginsToLoad) downto 0 do
//Here we add all the Script-freeing-leftovers (like BMParray etc) if PluginsToLoad[i] = TempNum then
// ^ This will all be done with Client.Destroy; Exit;
end; SetLength(PluginsToLoad,Length(PluginsToLoad)+1);
PluginsToLoad[High(PluginsToLoad)] := TempNum;
function TMMLPSThread.RequireFile(Sender: TObject; end;
const OriginFileName: String; var FileName, OutPut: string): Boolean; end;
begin Continue:= True;
end;
Result := False;
end; procedure TMMLPSThread.OnCompile(Sender: TPSScript);
var
procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler); i,ii : integer;
begin begin
SIRegister_Std(x); for i := high(PluginsToLoad) downto 0 do
SIRegister_Controls(x); for ii := 0 to PluginsGlob.MPlugins[PluginsToLoad[i]].MethodLen - 1 do
SIRegister_Classes(x, true); PSScript.AddFunctionEx(PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[i].FuncPtr,
SIRegister_Graphics(x, true); PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[i].FuncStr, cdStdCall);
SIRegister_stdctrls(x); // Here we add all the functions to the engine.
SIRegister_Forms(x); {$I PSInc/pscompile.inc}
SIRegister_ExtCtrls(x); end;
end;
procedure TMMLPSThread.AfterExecute(Sender: TPSScript);
procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec; begin
x: TPSRuntimeClassImporter); //Here we add all the Script-freeing-leftovers (like BMParray etc)
begin // ^ This will all be done with Client.Destroy;
RIRegister_Std(x); end;
RIRegister_Classes(x, True);
RIRegister_Controls(x); function TMMLPSThread.RequireFile(Sender: TObject;
RIRegister_Graphics(x, True); const OriginFileName: String; var FileName, OutPut: string): Boolean;
RIRegister_stdctrls(x); begin
RIRegister_Forms(x);
RIRegister_ExtCtrls(x); Result := False;
end; end;
procedure TMMLPSThread.OutputMessages; procedure TMMLPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
var begin
l: Longint; SIRegister_Std(x);
b: Boolean; SIRegister_Controls(x);
begin SIRegister_Classes(x, true);
b := False; SIRegister_Graphics(x, true);
for l := 0 to PSScript.CompilerMessageCount - 1 do SIRegister_stdctrls(x);
begin SIRegister_Forms(x);
psWriteln(PSScript.CompilerErrorToStr(l)); SIRegister_ExtCtrls(x);
if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then end;
begin
b := True; procedure TMMLPSThread.OnExecImport(Sender: TObject; se: TPSExec;
// FormMain.CurrSynEdit.SelStart := PSScript.CompilerMessages[l].Pos; x: TPSRuntimeClassImporter);
begin
end; RIRegister_Std(x);
end; RIRegister_Classes(x, True);
end; RIRegister_Controls(x);
RIRegister_Graphics(x, True);
procedure TMMLPSThread.Execute; RIRegister_stdctrls(x);
var RIRegister_Forms(x);
time: Integer; RIRegister_ExtCtrls(x);
begin; end;
CurrThread := Self;
time := lclintf.GetTickCount; procedure TMMLPSThread.OutputMessages;
try var
if PSScript.Compile then l: Longint;
begin b: Boolean;
OutputMessages; begin
psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.'); b := False;
// if not (ScriptState = SCompiling) then for l := 0 to PSScript.CompilerMessageCount - 1 do
if not PSScript.Execute then begin
begin psWriteln(PSScript.CompilerErrorToStr(l));
// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition; if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then
psWriteln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.' begin
+Inttostr(PSScript.ExecErrorByteCodePosition)); b := True;
end else psWriteln('Succesfully executed'); // FormMain.CurrSynEdit.SelStart := PSScript.CompilerMessages[l].Pos;
end else
begin end;
OutputMessages; end;
psWriteln('Compiling failed'); end;
end;
except procedure TMMLPSThread.Execute;
on E : Exception do var
psWriteln('Error: ' + E.Message); time: Integer;
end; begin;
end; CurrThread := Self;
time := lclintf.GetTickCount;
procedure TMMLPSThread.SetPSScript(Script: string); try
begin if PSScript.Compile then
PSScript.Script.Text:= Script; begin
end; OutputMessages;
psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.');
procedure TMMLPSThread.SetDebug(Strings: TMemo); // if not (ScriptState = SCompiling) then
begin if not PSScript.Execute then
DebugTo := Strings; begin
end; // FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition;
psWriteln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.'
+Inttostr(PSScript.ExecErrorByteCodePosition));
{ Include stuff here? } end else psWriteln('Succesfully executed');
end else
//{$I inc/colors.inc} begin
//{$I inc/bitmaps.inc} OutputMessages;
psWriteln('Compiling failed');
end;
end. except
on E : Exception do
psWriteln('Error: ' + E.Message);
end;
end;
procedure TMMLPSThread.SetPSScript(Script: string);
begin
PSScript.Script.Text:= Script;
end;
procedure TMMLPSThread.SetDebug(Strings: TMemo);
begin
DebugTo := Strings;
end;
{ Include stuff here? }
//{$I inc/colors.inc}
//{$I inc/bitmaps.inc}
end.

81
Units/MMLAddon/mmlthread.pas
View File

@ -1,81 +0,0 @@
unit MMLThread;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, client;
type
TMMLThread = class(TThread)
protected
Client: TClient;
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
end;
implementation
{
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 TMMLThread.Create(CreateSuspended : boolean);
begin
Client := TClient.Create;
// Create Stuff here
FreeOnTerminate := True;
inherited Create(CreateSuspended);
end;
destructor TMMLThread.Destroy;
begin
Client.Destroy;
inherited Destroy;
end;
procedure TMMLThread.Execute;
var
i,w,h: Integer;
begin
w := 0;
h := 0;
i := 0;
while (not Terminated) and (i < 10) do
begin
Sleep(1000);
Client.MWindow.GetDimensions(W, H);
writeln(inttostr(w) + ', ' + inttostr(h));
Inc(i);
end;
end;
{ Include stuff here? }
//{$I inc/colors.inc}
//{$I inc/bitmaps.inc}
end.

401
Units/MMLAddon/plugins.pas
View File

@ -1,189 +1,212 @@
unit plugins; {
This file is part of the Mufasa Macro Library (MML)
{ Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
Problems with SMART; you cannot free the plugin when smart is open..
Therefore, loading & free-ing plugins per script run is not an option. MML is free software: you can redistribute it and/or modify
Assigning a TMPlugin per Tab might be a do-able solution, but will still cope with the SMART Problems.. it under the terms of the GNU General Public License as published by
So the question is: Plugins Per Tab,Per Run or Global? the Free Software Foundation, either version 3 of the License, or
} (at your option) any later version.
{$mode objfpc}{$H+}
MML is distributed in the hope that it will be useful,
interface but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
uses GNU General Public License for more details.
Classes, SysUtils,dynlibs;
You should have received a copy of the GNU General Public License
type along with MML. If not, see <http://www.gnu.org/licenses/>.
TMPluginMethod = record
FuncPtr : pointer; See the file COPYING, included in this distribution,
FuncStr : string; for details about the copyright.
end;
Plugins Class for the Mufasa Macro Library
TMPlugin = record }
Methods : Array of TMPluginMethod;
dllHandle : TLibHandle; unit plugins;
filename : string;
MethodLen : integer; {
end; Problems with SMART; you cannot free the plugin when smart is open..
TMPluginArray = array of TMPlugin; Therefore, loading & free-ing plugins per script run is not an option.
Assigning a TMPlugin per Tab might be a do-able solution, but will still cope with the SMART Problems..
{ TMPlugins } So the question is: Plugins Per Tab,Per Run or Global?
}
TMPlugins = class (TObject) {$mode objfpc}{$H+}
private
Plugins : TMPluginArray; interface
PluginLen : integer;
procedure FreePlugins; uses
public Classes, SysUtils,dynlibs;
PluginDirs : TStringList;
procedure ValidateDirs; type
procedure LoadPluginsDir( DirIndex : integer); TMPluginMethod = record
function LoadPlugin(PluginName : string) : integer; FuncPtr : pointer;
property Count : integer read PluginLen; FuncStr : string;
property MPlugins : TMPluginArray read Plugins; end;
constructor Create;
destructor Destroy;override; TMPlugin = record
end; Methods : Array of TMPluginMethod;
dllHandle : TLibHandle;
filename : string;
MethodLen : integer;
implementation end;
TMPluginArray = array of TMPlugin;
uses
MufasaTypes,FileUtil; { TMPlugins }
{ TMPlugins } TMPlugins = class (TObject)
private
procedure TMPlugins.FreePlugins; Plugins : TMPluginArray;
var PluginLen : integer;
I : integer; procedure FreePlugins;
begin public
for i := 0 to PluginLen - 1 do PluginDirs : TStringList;
begin; procedure ValidateDirs;
if (Plugins[i].dllHandle > 0) then procedure LoadPluginsDir( DirIndex : integer);
try function LoadPlugin(PluginName : string) : integer;
Writeln(inttostr(I)); property Count : integer read PluginLen;
FreeLibrary(Plugins[i].dllHandle); property MPlugins : TMPluginArray read Plugins;
except constructor Create;
end; destructor Destroy;override;
end; end;
SetLength(Plugins,0);
PluginLen:= 0;
end;
implementation
procedure TMPlugins.ValidateDirs;
var uses
i : integer; MufasaTypes,FileUtil;
TempStr : string;
begin { TMPlugins }
for i := 0 to PluginDirs.Count - 1 do
begin; procedure TMPlugins.FreePlugins;
if DirectoryExists(PluginDirs.Strings[i]) = false then var
raise Exception.createFMT('Directory(%s) does not exist',[PluginDirs[i]]); I : integer;
TempStr := PluginDirs.Strings[i]; begin
if (TempStr[Length(TempStr)] <> DS) then for i := 0 to PluginLen - 1 do
begin; begin;
if (TempStr[Length(TempStr)] = '\') or (TempStr[Length(TempStr)] = '/') then if (Plugins[i].dllHandle > 0) then
TempStr[Length(TempStr)] := DS try
else Writeln(inttostr(I));
TempStr := TempStr + DS; FreeLibrary(Plugins[i].dllHandle);
PluginDirs.Strings[i] := TempStr; except
end; end;
end; end;
end; SetLength(Plugins,0);
PluginLen:= 0;
procedure TMPlugins.LoadPluginsDir(DirIndex: integer); end;
var
PlugExt: String = {$IFDEF LINUX}'*.so';{$ELSE}'*.dll';{$ENDIF} procedure TMPlugins.ValidateDirs;
FileSearcher : TSearchRec; var
begin i : integer;
if (DirIndex < 0) or (DirIndex >= PluginDirs.Count) then TempStr : string;
Exit; begin
if FindFirst(PluginDirs.Strings[DirIndex] + PlugExt, faAnyFile, FileSearcher) <> 0 then for i := 0 to PluginDirs.Count - 1 do
begin; begin;
FindClose(FileSearcher); if DirectoryExists(PluginDirs.Strings[i]) = false then
Exit; raise Exception.createFMT('Directory(%s) does not exist',[PluginDirs[i]]);
end; TempStr := PluginDirs.Strings[i];
repeat if (TempStr[Length(TempStr)] <> DS) then
LoadPlugin(FileSearcher.Name); begin;
until FindNext(FileSearcher) <> 0; if (TempStr[Length(TempStr)] = '\') or (TempStr[Length(TempStr)] = '/') then
FindClose(FileSearcher); TempStr[Length(TempStr)] := DS
end; else
TempStr := TempStr + DS;
function TMPlugins.LoadPlugin(PluginName: string): Integer; PluginDirs.Strings[i] := TempStr;
var end;
i, ii : integer; end;
pntrArrc : function : integer; stdcall; end;
GetFuncInfo : function (x: Integer; var ProcAddr: Pointer; var ProcDef: PChar) : Integer; stdcall;
GetTypeCount : function : Integer; stdcall; procedure TMPlugins.LoadPluginsDir(DirIndex: integer);
GetTypeInfo : function (x: Integer; var sType, sTypeDef: string): Integer; stdcall; var
PD : PChar; PlugExt: String = {$IFDEF LINUX}'*.so';{$ELSE}'*.dll';{$ENDIF}
pntr : Pointer; FileSearcher : TSearchRec;
arrc : integer; begin
Status : LongInt; if (DirIndex < 0) or (DirIndex >= PluginDirs.Count) then
PlugExt: String = {$IFDEF LINUX}'.so';{$ELSE}'.dll';{$ENDIF} Exit;
begin if FindFirst(PluginDirs.Strings[DirIndex] + PlugExt, faAnyFile, FileSearcher) <> 0 then
ii := -1; begin;
result := -1; FindClose(FileSearcher);
if PluginDirs.Count = 0 then Exit;
Exit; end;
ValidateDirs; repeat
PluginName := ExtractFileNameWithoutExt(PluginName); LoadPlugin(FileSearcher.Name);
for i := 0 to PluginDirs.Count - 1 do until FindNext(FileSearcher) <> 0;
if FileExists(PluginDirs.Strings[i] + Pluginname + PlugExt) then FindClose(FileSearcher);
begin; end;
if ii <> -1 then
Raise Exception.CreateFmt('Plugin(%s) has been found multiple times',[PluginName]); function TMPlugins.LoadPlugin(PluginName: string): Integer;
ii := i; var
end; i, ii : integer;
if ii = -1 then pntrArrc : function : integer; stdcall;
raise Exception.CreateFMT('Plugins(%s) has not been found',[PluginName]); GetFuncInfo : function (x: Integer; var ProcAddr: Pointer; var ProcDef: PChar) : Integer; stdcall;
for i := 0 to PluginLen - 1 do GetTypeCount : function : Integer; stdcall;
if Plugins[i].filename = (PluginDirs.Strings[ii] + PluginName + PlugExt) then GetTypeInfo : function (x: Integer; var sType, sTypeDef: string): Integer; stdcall;
Exit(i); PD : PChar;
pd := StrAlloc(255); pntr : Pointer;
SetLength(Plugins,PluginLen + 1); arrc : integer;
Writeln(Format('Loading plugin %s at %s',[PluginName,PluginDirs.Strings[ii]])); Status : LongInt;
Plugins[PluginLen].filename:= PluginDirs.Strings[ii] + Pluginname + PlugExt; PlugExt: String = {$IFDEF LINUX}'.so';{$ELSE}'.dll';{$ENDIF}
Plugins[PluginLen].dllHandle:= LoadLibrary(PChar(Plugins[PluginLen].filename)); begin
if Plugins[PluginLen].dllHandle = 0 then ii := -1;
Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]); result := -1;
Pointer(pntrArrc) := GetProcAddress(Plugins[PluginLen].dllHandle, PChar('GetFunctionCount')); if PluginDirs.Count = 0 then
if @pntrArrc = nil then Exit;
Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]); ValidateDirs;
arrc := pntrArrc(); PluginName := ExtractFileNameWithoutExt(PluginName);
SetLength(Plugins[PluginLen].Methods, ArrC); for i := 0 to PluginDirs.Count - 1 do
Pointer(GetFuncInfo) := GetProcAddress(Plugins[PluginLen].dllHandle, PChar('GetFunctionInfo')); if FileExists(PluginDirs.Strings[i] + Pluginname + PlugExt) then
if @GetFuncInfo = nil then begin;
Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]); if ii <> -1 then
Plugins[PluginLen].MethodLen := Arrc; Raise Exception.CreateFmt('Plugin(%s) has been found multiple times',[PluginName]);
for ii := 0 to ArrC-1 do ii := i;
begin; end;
if (GetFuncInfo(ii, pntr, pd) < 0) then if ii = -1 then
Continue; raise Exception.CreateFMT('Plugins(%s) has not been found',[PluginName]);
Plugins[Pluginlen].Methods[ii].FuncPtr := pntr; for i := 0 to PluginLen - 1 do
Plugins[Pluginlen].Methods[ii].FuncStr := pd; if Plugins[i].filename = (PluginDirs.Strings[ii] + PluginName + PlugExt) then
end; Exit(i);
Result := PluginLen; pd := StrAlloc(255);
inc(PluginLen); SetLength(Plugins,PluginLen + 1);
StrDispose(pd); Writeln(Format('Loading plugin %s at %s',[PluginName,PluginDirs.Strings[ii]]));
Plugins[PluginLen].filename:= PluginDirs.Strings[ii] + Pluginname + PlugExt;
end; Plugins[PluginLen].dllHandle:= LoadLibrary(PChar(Plugins[PluginLen].filename));
if Plugins[PluginLen].dllHandle = 0 then
Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]);
constructor TMPlugins.Create; Pointer(pntrArrc) := GetProcAddress(Plugins[PluginLen].dllHandle, PChar('GetFunctionCount'));
begin if @pntrArrc = nil then
inherited Create; Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]);
PluginLen := 0; arrc := pntrArrc();
PluginDirs := TStringList.Create; SetLength(Plugins[PluginLen].Methods, ArrC);
end; Pointer(GetFuncInfo) := GetProcAddress(Plugins[PluginLen].dllHandle, PChar('GetFunctionInfo'));
if @GetFuncInfo = nil then
destructor TMPlugins.Destroy; Raise Exception.CreateFMT('Error loading plugin %s',[Plugins[PluginLen].filename]);
begin Plugins[PluginLen].MethodLen := Arrc;
FreePlugins; for ii := 0 to ArrC-1 do
PluginDirs.Free; begin;
inherited Destroy; if (GetFuncInfo(ii, pntr, pd) < 0) then
end; Continue;
Plugins[Pluginlen].Methods[ii].FuncPtr := pntr;
end. Plugins[Pluginlen].Methods[ii].FuncStr := pd;
end;
Result := PluginLen;
inc(PluginLen);
StrDispose(pd);
end;
constructor TMPlugins.Create;
begin
inherited Create;
PluginLen := 0;
PluginDirs := TStringList.Create;
end;
destructor TMPlugins.Destroy;
begin
FreePlugins;
PluginDirs.Free;
inherited Destroy;
end;
end.

335
Units/MMLAddon/windowselector.pas
View File

@ -1,156 +1,179 @@
unit windowselector; {
This file is part of the Mufasa Macro Library (MML)
{$mode objfpc}{$H+} Copyright (c) 2009 by Raymond van Venentië and Merlijn Wajer
interface MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
uses the Free Software Foundation, either version 3 of the License, or
Classes, SysUtils, (at your option) any later version.
ctypes,
window, windowutil, MML is distributed in the hope that it will be useful,
controls, but WITHOUT ANY WARRANTY; without even the implied warranty of
graphics, MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
forms, GNU General Public License for more details.
{$IFNDEF MSWINDOWS}x, xlib
{$ELSE} You should have received a copy of the GNU General Public License
windows along with MML. If not, see <http://www.gnu.org/licenses/>.
{$ENDIF}
See the file COPYING, included in this distribution,
; for details about the copyright.
type WindowSelector for the Mufasa Macro Library
TMWindowSelector = class(TObject) }
constructor Create(aWindow: TMWindow);
destructor Destroy; override; unit windowselector;
{$IFDEF LINUX} {$mode objfpc}{$H+}
function Drag: x.TWindow;
{$ELSE} interface
function Drag: Hwnd;
{$ENDIF} uses
Classes, SysUtils,
public ctypes,
Window: TMWindow; window, windowutil,
controls,
end; graphics,
forms,
{$IFNDEF MSWINDOWS}x, xlib
implementation {$ELSE}
windows
{$ENDIF}
constructor TMWindowSelector.Create(aWindow: TMWindow);
begin ;
inherited create;
type
Self.Window := aWindow; TMWindowSelector = class(TObject)
constructor Create(aWindow: TMWindow);
end; destructor Destroy; override;
{$IFDEF LINUX}
destructor TMWindowSelector.Destroy; function Drag: x.TWindow;
begin {$ELSE}
function Drag: Hwnd;
inherited; {$ENDIF}
end;
public
{$IFDEF LINUX} Window: TMWindow;
function TMWindowSelector.Drag: x.TWindow;
var end;
Tempwindow : x.TWindow;
root : x.TWindow;
subwindow : x.TWindow; implementation
x_root, y_root : cint;
xmask : cuint;
x, y : cint; constructor TMWindowSelector.Create(aWindow: TMWindow);
Old_Handler : TXErrorHandler; begin
inherited create;
begin
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); Self.Window := aWindow;
Result := 0; end;
repeat
XQueryPointer(Window.XDisplay, Window.DesktopWindow, @root, destructor TMWindowSelector.Destroy;
@Tempwindow, @x_root, @y_root, begin
@x, @y, @xmask);
subwindow:= Tempwindow; inherited;
end;
while subwindow <> 0 do
begin {$IFDEF LINUX}
Tempwindow := subwindow; function TMWindowSelector.Drag: x.TWindow;
XQueryPointer(Window.XDisplay, Tempwindow, @root, var
@subwindow, @x_root, @y_root, Tempwindow : x.TWindow;
@x, @y, @xmask); root : x.TWindow;
end; subwindow : x.TWindow;
if Result <> Tempwindow then x_root, y_root : cint;
begin xmask : cuint;
WriteLn('Changing Window to: ' + IntToStr(Tempwindow)); x, y : cint;
Result := Tempwindow; Old_Handler : TXErrorHandler;
end;
begin
Sleep(16); Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
until (xmask and Button1Mask) = 0; Result := 0;
XSetErrorHandler(Old_handler); repeat
end; XQueryPointer(Window.XDisplay, Window.DesktopWindow, @root,
@Tempwindow, @x_root, @y_root,
{$ELSE} @x, @y, @xmask);
subwindow:= Tempwindow;
function TMWindowSelector.Drag: Hwnd;
var while subwindow <> 0 do
TargetRect: TRect; begin
DC: HDC; Tempwindow := subwindow;
OldPen, Pen: hPen; XQueryPointer(Window.XDisplay, Tempwindow, @root,
OldBrush : hBrush; @subwindow, @x_root, @y_root,
BrushHandle : THandle; @x, @y, @xmask);
Cursor : TCursor; end;
TempHandle : Hwnd; if Result <> Tempwindow then
Handle : Hwnd; begin
begin; WriteLn('Changing Window to: ' + IntToStr(Tempwindow));
Pen := CreatePen(PS_SOLID, GetSystemMetrics(SM_CXBORDER)*5, clred); Result := Tempwindow;
BrushHandle := GetStockObject(Null_Brush); end;
Cursor:= Screen.Cursor;
Screen.Cursor:= crCross; Sleep(16);
TempHandle := GetDesktopWindow;
while GetAsyncKeyState(VK_LBUTTON) <> 0 do until (xmask and Button1Mask) = 0;
begin;
Handle:= WindowFromPoint(Mouse.CursorPos); XSetErrorHandler(Old_handler);
if Handle <> TempHandle then end;
begin;
if TempHandle <> 0 then {$ELSE}
begin;
Invalidaterect(temphandle, nil, true); function TMWindowSelector.Drag: Hwnd;
UpdateWindow(temphandle); var
{$IFDEF MSWINDOWS} TargetRect: TRect;
RedrawWindow(TempHandle, nil, 0, RDW_Frame or RDW_Invalidate or RDW_Updatenow or RDW_Allchildren); DC: HDC;
{$ENDIF} OldPen, Pen: hPen;
end; OldBrush : hBrush;
if Handle <> 0 then BrushHandle : THandle;
begin; Cursor : TCursor;
GetWindowRect(Handle, TargetRect); TempHandle : Hwnd;
DC := Windows.GetWindowDC(Handle); Handle : Hwnd;
OldPen := SelectObject(DC, Pen); begin;
OldBrush := SelectObject(DC, BrushHandle); Pen := CreatePen(PS_SOLID, GetSystemMetrics(SM_CXBORDER)*5, clred);
Rectangle(DC, 0, 0, TargetRect.Right - TargetRect.Left, TargetRect.Bottom - TargetRect.Top); BrushHandle := GetStockObject(Null_Brush);
SelectObject(DC, OldBrush); Cursor:= Screen.Cursor;
SelectObject(DC, OldPen); Screen.Cursor:= crCross;
ReleaseDC(Handle, DC); TempHandle := GetDesktopWindow;
end; while GetAsyncKeyState(VK_LBUTTON) <> 0 do
TempHandle := Handle; begin;
end; Handle:= WindowFromPoint(Mouse.CursorPos);
Sleep(64); if Handle <> TempHandle then
end; begin;
Result := TempHandle; if TempHandle <> 0 then
Screen.Cursor:= cursor; begin;
Invalidaterect(temphandle, nil, true); Invalidaterect(temphandle, nil, true);
UpdateWindow(temphandle); UpdateWindow(temphandle);
RedrawWindow(TempHandle, nil, 0, RDW_Frame or RDW_Invalidate or RDW_Updatenow or RDW_Allchildren); {$IFDEF MSWINDOWS}
DeleteObject(Pen); RedrawWindow(TempHandle, nil, 0, RDW_Frame or RDW_Invalidate or RDW_Updatenow or RDW_Allchildren);
end; {$ENDIF}
{$ENDIF} end;
if Handle <> 0 then
begin;
GetWindowRect(Handle, TargetRect);
end. DC := Windows.GetWindowDC(Handle);
OldPen := SelectObject(DC, Pen);
OldBrush := SelectObject(DC, BrushHandle);
Rectangle(DC, 0, 0, TargetRect.Right - TargetRect.Left, TargetRect.Bottom - TargetRect.Top);
SelectObject(DC, OldBrush);
SelectObject(DC, OldPen);
ReleaseDC(Handle, DC);
end;
TempHandle := Handle;
end;
Sleep(64);
end;
Result := TempHandle;
Screen.Cursor:= cursor;
Invalidaterect(temphandle, nil, true);
UpdateWindow(temphandle);
RedrawWindow(TempHandle, nil, 0, RDW_Frame or RDW_Invalidate or RDW_Updatenow or RDW_Allchildren);
DeleteObject(Pen);
end;
{$ENDIF}
end.