From 150ad9fcf156341faa578e8f2b874d3783844a92 Mon Sep 17 00:00:00 2001 From: Raymond Date: Sun, 13 Sep 2009 02:18:35 +0000 Subject: [PATCH] Added Bitmaps git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@46 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Projects/SAMufasaGUI/project1.lpi | 496 ++++++++++++++-------- Projects/SAMufasaGUI/project1.lpr | 2 +- Tests/PS/SimpleBMPLoader.txt | 142 +++++++ Units/MMLAddon/PSInc/Wrappers/bitmap.inc | 44 ++ Units/MMLAddon/PSInc/pscompile.inc | 17 +- Units/MMLAddon/mmlpsthread.pas | 507 +++++++++++------------ Units/MMLCore/bitmaps.pas | 322 ++++++++++++++ Units/MMLCore/client.pas | 5 +- Units/Misc/dcpbase64.pas | 140 +++++++ 9 files changed, 1250 insertions(+), 425 deletions(-) create mode 100644 Tests/PS/SimpleBMPLoader.txt create mode 100644 Units/MMLAddon/PSInc/Wrappers/bitmap.inc create mode 100644 Units/MMLCore/bitmaps.pas create mode 100644 Units/Misc/dcpbase64.pas diff --git a/Projects/SAMufasaGUI/project1.lpi b/Projects/SAMufasaGUI/project1.lpi index f8eda64..7efe446 100644 --- a/Projects/SAMufasaGUI/project1.lpi +++ b/Projects/SAMufasaGUI/project1.lpi @@ -7,7 +7,7 @@ <UseXPManifest Value="True"/> - <ActiveEditorIndexAtStart Value="7"/> + <ActiveEditorIndexAtStart Value="5"/> </General> <VersionInfo> <ProjectVersion Value=""/> @@ -33,15 +33,15 @@ <PackageName Value="LCL"/> </Item2> </RequiredPackages> - <Units Count="69"> + <Units Count="92"> <Unit0> <Filename Value="project1.lpr"/> <IsPartOfProject Value="True"/> <UnitName Value="project1"/> - <CursorPos X="13" Y="17"/> + <CursorPos X="34" Y="11"/> <TopLine Value="1"/> <EditorIndex Value="0"/> - <UsageCount Value="76"/> + <UsageCount Value="90"/> <Loaded Value="True"/> </Unit0> <Unit1> @@ -51,117 +51,117 @@ <UnitName Value="TestUnit"/> <CursorPos X="33" Y="57"/> <TopLine Value="32"/> - <UsageCount Value="55"/> + <UsageCount Value="53"/> </Unit1> <Unit2> <Filename Value="client.pas"/> <UnitName Value="Client"/> <CursorPos X="18" Y="34"/> <TopLine Value="10"/> - <UsageCount Value="55"/> + <UsageCount Value="53"/> </Unit2> <Unit3> <Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/> <UnitName Value="CompTypes"/> <CursorPos X="13" Y="531"/> <TopLine Value="523"/> - <UsageCount Value="22"/> + <UsageCount Value="20"/> </Unit3> <Unit4> <Filename Value="mufasatypes.pas"/> <UnitName Value="MufasaTypes"/> <CursorPos X="52" Y="20"/> <TopLine Value="1"/> - <UsageCount Value="55"/> + <UsageCount Value="53"/> </Unit4> <Unit5> <Filename Value="window.pas"/> <UnitName Value="Window"/> <CursorPos X="4" Y="100"/> <TopLine Value="85"/> - <UsageCount Value="55"/> + <UsageCount Value="53"/> </Unit5> <Unit6> <Filename Value="../Documents/fpc/rtl/inc/systemh.inc"/> <CursorPos X="3" Y="261"/> <TopLine Value="246"/> - <UsageCount Value="8"/> + <UsageCount Value="6"/> </Unit6> <Unit7> <Filename Value="input.pas"/> <UnitName Value="Input"/> <CursorPos X="5" Y="20"/> <TopLine Value="15"/> - <UsageCount Value="54"/> + <UsageCount Value="52"/> </Unit7> <Unit8> <Filename Value="../cogat/Units/CogatUnits/compinput.pas"/> <UnitName Value="CompInput"/> <CursorPos X="43" Y="250"/> <TopLine Value="236"/> - <UsageCount Value="20"/> + <UsageCount Value="18"/> </Unit8> <Unit9> <Filename Value="Units/MMLCore/client.pas"/> <UnitName Value="Client"/> <CursorPos X="46" Y="8"/> <TopLine Value="1"/> - <UsageCount Value="24"/> + <UsageCount Value="22"/> </Unit9> <Unit10> <Filename Value="Units/MMLCore/input.pas"/> <UnitName Value="Input"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <UsageCount Value="24"/> + <UsageCount Value="22"/> </Unit10> <Unit11> <Filename Value="Units/MMLCore/mufasatypes.pas"/> <UnitName Value="MufasaTypes"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <UsageCount Value="24"/> + <UsageCount Value="22"/> </Unit11> <Unit12> <Filename Value="Units/MMLCore/window.pas"/> <UnitName Value="Window"/> <CursorPos X="69" Y="254"/> <TopLine Value="251"/> - <UsageCount Value="24"/> + <UsageCount Value="22"/> </Unit12> <Unit13> <Filename Value="Units/MMLCore/windowutil.pas"/> <UnitName Value="windowutil"/> <CursorPos X="54" Y="20"/> <TopLine Value="20"/> - <UsageCount Value="47"/> + <UsageCount Value="45"/> </Unit13> <Unit14> <Filename Value="../Documents/lazarus/lcl/graphics.pp"/> <UnitName Value="Graphics"/> <CursorPos X="15" Y="1287"/> <TopLine Value="1272"/> - <UsageCount Value="17"/> + <UsageCount Value="15"/> </Unit14> <Unit15> <Filename Value="../cogat/Units/CogatUnits/compbitmaps.pas"/> <UnitName Value="CompBitmaps"/> <CursorPos X="1" Y="109"/> <TopLine Value="92"/> - <UsageCount Value="17"/> + <UsageCount Value="15"/> </Unit15> <Unit16> <Filename Value="../Documents/lazarus/lcl/include/rasterimage.inc"/> <CursorPos X="1" Y="1"/> <TopLine Value="691"/> - <UsageCount Value="9"/> + <UsageCount Value="7"/> </Unit16> <Unit17> <Filename Value="../Documents/fpc/packages/x11/src/xlib.pp"/> <UnitName Value="xlib"/> <CursorPos X="47" Y="1272"/> <TopLine Value="1257"/> - <UsageCount Value="12"/> + <UsageCount Value="10"/> </Unit17> <Unit18> <Filename Value="testunit.pas"/> @@ -170,10 +170,10 @@ <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="TestUnit"/> - <CursorPos X="5" Y="275"/> - <TopLine Value="265"/> - <EditorIndex Value="7"/> - <UsageCount Value="42"/> + <CursorPos X="24" Y="264"/> + <TopLine Value="250"/> + <EditorIndex Value="6"/> + <UsageCount Value="56"/> <Loaded Value="True"/> </Unit18> <Unit19> @@ -181,40 +181,40 @@ <UnitName Value="CompColors"/> <CursorPos X="44" Y="914"/> <TopLine Value="897"/> - <UsageCount Value="15"/> + <UsageCount Value="13"/> </Unit19> <Unit20> <Filename Value="../Documents/fpc/packages/x11/src/x.pp"/> <UnitName Value="x"/> <CursorPos X="4" Y="179"/> <TopLine Value="164"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit20> <Unit21> <Filename Value="../Documents/fpc/rtl/unix/aliasctp.inc"/> <CursorPos X="63" Y="45"/> <TopLine Value="30"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit21> <Unit22> <Filename Value="../cogat/Units/CogatUnits/compdragger.pas"/> <UnitName Value="CompDragger"/> <CursorPos X="33" Y="14"/> <TopLine Value="6"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit22> <Unit23> <Filename Value="../Documents/lazarus/lcl/lcltype.pp"/> <UnitName Value="LCLType"/> <CursorPos X="9" Y="99"/> <TopLine Value="83"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit23> <Unit24> <Filename Value="testunit.lfm"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> <SyntaxHighlighter Value="LFM"/> </Unit24> <Unit25> @@ -222,100 +222,100 @@ <UnitName Value="Unix"/> <CursorPos X="63" Y="63"/> <TopLine Value="56"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit25> <Unit26> <Filename Value="../Compilertje/Units/CogatUnits/compinput.pas"/> <UnitName Value="CompInput"/> <CursorPos X="6" Y="462"/> <TopLine Value="449"/> - <UsageCount Value="12"/> + <UsageCount Value="10"/> </Unit26> <Unit27> <Filename Value="../FPC/FPCCheckout/rtl/win/wininc/func.inc"/> <CursorPos X="10" Y="663"/> <TopLine Value="635"/> - <UsageCount Value="11"/> + <UsageCount Value="9"/> </Unit27> <Unit28> <Filename Value="../Compilertje/Units/CogatUnits/comptypes.pas"/> <UnitName Value="CompTypes"/> <CursorPos X="13" Y="418"/> <TopLine Value="402"/> - <UsageCount Value="11"/> + <UsageCount Value="9"/> </Unit28> <Unit29> <Filename Value="../Compilertje/Units/CogatUnits/compcolors.pas"/> <UnitName Value="CompColors"/> <CursorPos X="12" Y="603"/> <TopLine Value="573"/> - <UsageCount Value="11"/> + <UsageCount Value="9"/> </Unit29> <Unit30> <Filename Value="../lazarus/lcl/graphics.pp"/> <UnitName Value="Graphics"/> <CursorPos X="15" Y="1283"/> <TopLine Value="1270"/> - <UsageCount Value="11"/> + <UsageCount Value="9"/> </Unit30> <Unit31> <Filename Value="../lazarus/lcl/include/rasterimage.inc"/> <CursorPos X="20" Y="351"/> <TopLine Value="339"/> - <UsageCount Value="11"/> + <UsageCount Value="9"/> </Unit31> <Unit32> <Filename Value="../lazarus/lcl/intfgraphics.pas"/> <UnitName Value="IntfGraphics"/> <CursorPos X="3" Y="3251"/> <TopLine Value="3245"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit32> <Unit33> <Filename Value="../../Documents/fpc/packages/fcl-image/src/fpcanvas.pp"/> <UnitName Value="FPCanvas"/> <CursorPos X="23" Y="257"/> <TopLine Value="142"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit33> <Unit34> <Filename Value="../../Documents/fpc/packages/fcl-image/src/fpimage.pp"/> <UnitName Value="FPimage"/> <CursorPos X="3" Y="58"/> <TopLine Value="43"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit34> <Unit35> <Filename Value="../../Documents/fpc/packages/fcl-image/src/fpimage.inc"/> <CursorPos X="24" Y="25"/> <TopLine Value="1"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit35> <Unit36> <Filename Value="../../Documents/lazarus/lcl/graphics.pp"/> <UnitName Value="Graphics"/> <CursorPos X="88" Y="2395"/> <TopLine Value="2388"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit36> <Unit37> <Filename Value="../../Units/MMLCore/client.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="Client"/> - <CursorPos X="46" Y="4"/> + <CursorPos X="73" Y="23"/> <TopLine Value="1"/> - <EditorIndex Value="4"/> - <UsageCount Value="41"/> + <EditorIndex Value="5"/> + <UsageCount Value="55"/> <Loaded Value="True"/> </Unit37> <Unit38> <Filename Value="../../Units/MMLCore/mufasatypes.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="MufasaTypes"/> - <CursorPos X="4" Y="26"/> + <CursorPos X="27" Y="19"/> <TopLine Value="1"/> <EditorIndex Value="3"/> - <UsageCount Value="41"/> + <UsageCount Value="55"/> <Loaded Value="True"/> </Unit38> <Unit39> @@ -323,26 +323,26 @@ <UnitName Value="compFiles"/> <CursorPos X="18" Y="8"/> <TopLine Value="1"/> - <UsageCount Value="25"/> + <UsageCount Value="23"/> </Unit39> <Unit40> <Filename Value="../../Units/MMLCore/files.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="files"/> - <CursorPos X="3" Y="48"/> - <TopLine Value="19"/> - <EditorIndex Value="5"/> - <UsageCount Value="42"/> + <CursorPos X="25" Y="64"/> + <TopLine Value="30"/> + <EditorIndex Value="10"/> + <UsageCount Value="56"/> <Loaded Value="True"/> </Unit40> <Unit41> <Filename Value="../../Units/MMLCore/window.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="Window"/> - <CursorPos X="53" Y="163"/> - <TopLine Value="151"/> - <EditorIndex Value="6"/> - <UsageCount Value="41"/> + <CursorPos X="40" Y="263"/> + <TopLine Value="263"/> + <EditorIndex Value="11"/> + <UsageCount Value="55"/> <Loaded Value="True"/> </Unit41> <Unit42> @@ -350,30 +350,30 @@ <UnitName Value="Forms"/> <CursorPos X="15" Y="1236"/> <TopLine Value="981"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit42> <Unit43> <Filename Value="../../../cogat/Units/CogatUnits/comptypes.pas"/> <UnitName Value="CompTypes"/> <CursorPos X="80" Y="9"/> <TopLine Value="1"/> - <UsageCount Value="15"/> + <UsageCount Value="13"/> </Unit43> <Unit44> <Filename Value="../../Units/MMLCore/windowutil.pas"/> <UnitName Value="windowutil"/> - <CursorPos X="39" Y="19"/> - <TopLine Value="9"/> - <UsageCount Value="15"/> + <CursorPos X="96" Y="86"/> + <TopLine Value="75"/> + <EditorIndex Value="12"/> + <UsageCount Value="18"/> + <Loaded Value="True"/> </Unit44> <Unit45> <Filename Value="../../Units/MMLCore/input.pas"/> <UnitName Value="Input"/> <CursorPos X="3" Y="90"/> <TopLine Value="59"/> - <EditorIndex Value="8"/> - <UsageCount Value="14"/> - <Loaded Value="True"/> + <UsageCount Value="16"/> </Unit45> <Unit46> <Filename Value="../../Units/MMLCore/finder.pas"/> @@ -382,15 +382,17 @@ <CursorPos X="27" Y="65"/> <TopLine Value="41"/> <EditorIndex Value="2"/> - <UsageCount Value="34"/> + <UsageCount Value="48"/> <Loaded Value="True"/> </Unit46> <Unit47> <Filename Value="../../../lazarus/lcl/graphics.pp"/> <UnitName Value="Graphics"/> - <CursorPos X="17" Y="2298"/> - <TopLine Value="2282"/> - <UsageCount Value="10"/> + <CursorPos X="17" Y="1353"/> + <TopLine Value="1341"/> + <EditorIndex Value="21"/> + <UsageCount Value="15"/> + <Loaded Value="True"/> </Unit47> <Unit48> <Filename Value="../../Units/MMLAddon/mmlthread.pas"/> @@ -398,22 +400,22 @@ <UnitName Value="MMLThread"/> <CursorPos X="132" Y="5"/> <TopLine Value="1"/> - <UsageCount Value="32"/> + <UsageCount Value="46"/> </Unit48> <Unit49> <Filename Value="../../../Documents/fpc/rtl/objpas/classes/classesh.inc"/> <CursorPos X="27" Y="1430"/> <TopLine Value="1422"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit49> <Unit50> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="mmlpsthread"/> - <CursorPos X="18" Y="153"/> - <TopLine Value="141"/> - <EditorIndex Value="9"/> - <UsageCount Value="30"/> + <CursorPos X="31" Y="132"/> + <TopLine Value="107"/> + <EditorIndex Value="7"/> + <UsageCount Value="44"/> <Loaded Value="True"/> </Unit50> <Unit51> @@ -421,45 +423,43 @@ <UnitName Value="uPSComponent"/> <CursorPos X="21" Y="193"/> <TopLine Value="183"/> - <EditorIndex Value="12"/> - <UsageCount Value="16"/> - <Loaded Value="True"/> + <UsageCount Value="18"/> </Unit51> <Unit52> <Filename Value="../../../FPC/FPCCheckout/rtl/objpas/classes/classesh.inc"/> - <CursorPos X="29" Y="1437"/> - <TopLine Value="1409"/> - <UsageCount Value="14"/> + <CursorPos X="30" Y="260"/> + <TopLine Value="244"/> + <EditorIndex Value="4"/> + <UsageCount Value="15"/> + <Loaded Value="True"/> </Unit52> <Unit53> <Filename Value="../../../FPC/FPCCheckout/rtl/objpas/types.pp"/> <UnitName Value="types"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <UsageCount Value="12"/> + <UsageCount Value="10"/> </Unit53> <Unit54> <Filename Value="../../../FPC/FPCCheckout/rtl/objpas/typinfo.pp"/> <UnitName Value="typinfo"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <UsageCount Value="12"/> + <UsageCount Value="10"/> </Unit54> <Unit55> <Filename Value="../../Units/PascalScript/uPSC_forms.pas"/> <UnitName Value="uPSC_forms"/> <CursorPos X="1" Y="1"/> <TopLine Value="1"/> - <EditorIndex Value="11"/> - <UsageCount Value="15"/> - <Loaded Value="True"/> + <UsageCount Value="17"/> </Unit55> <Unit56> <Filename Value="project1.lrs"/> <CursorPos X="70" Y="41"/> - <TopLine Value="10"/> + <TopLine Value="7"/> <EditorIndex Value="1"/> - <UsageCount Value="15"/> + <UsageCount Value="22"/> <Loaded Value="True"/> </Unit56> <Unit57> @@ -467,205 +467,377 @@ <UnitName Value="LResources"/> <CursorPos X="3" Y="1396"/> <TopLine Value="1396"/> - <UsageCount Value="12"/> + <UsageCount Value="10"/> </Unit57> <Unit58> <Filename Value="../../../lazarus/components/synedit/synmemo.pas"/> <UnitName Value="SynMemo"/> <CursorPos X="16" Y="150"/> <TopLine Value="31"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit58> <Unit59> <Filename Value="../../../lazarus/components/synedit/syneditmiscclasses.pp"/> <UnitName Value="SynEditMiscClasses"/> <CursorPos X="29" Y="100"/> <TopLine Value="92"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit59> <Unit60> <Filename Value="../../../lazarus/components/synedit/synedit.pp"/> <UnitName Value="SynEdit"/> <CursorPos X="22" Y="1531"/> <TopLine Value="1523"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit60> <Unit61> <Filename Value="../../../lazarus/components/synedit/syngutterchanges.pas"/> <UnitName Value="SynGutterChanges"/> <CursorPos X="34" Y="126"/> <TopLine Value="118"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit61> <Unit62> <Filename Value="../../../lazarus/components/synedit/syneditlines.pas"/> <UnitName Value="SynEditLines"/> <CursorPos X="21" Y="48"/> <TopLine Value="40"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit62> <Unit63> <Filename Value="../../../lazarus/components/synedit/synedittextbase.pas"/> <UnitName Value="SynEditTextBase"/> <CursorPos X="3" Y="75"/> <TopLine Value="124"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit63> <Unit64> <Filename Value="../../Units/PascalScript/uPSC_std.pas"/> <UnitName Value="uPSC_std"/> <CursorPos X="35" Y="8"/> <TopLine Value="1"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit64> <Unit65> <Filename Value="../../Units/PascalScript/uPSC_controls.pas"/> <UnitName Value="uPSC_controls"/> <CursorPos X="1" Y="1"/> <TopLine Value="11"/> - <UsageCount Value="10"/> + <UsageCount Value="8"/> </Unit65> <Unit66> <Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/> - <CursorPos X="64" Y="4"/> + <CursorPos X="31" Y="10"/> <TopLine Value="1"/> - <EditorIndex Value="10"/> - <UsageCount Value="11"/> + <EditorIndex Value="8"/> + <UsageCount Value="16"/> <Loaded Value="True"/> </Unit66> <Unit67> <Filename Value="../../../FPC/FPCCheckout/rtl/win/tthread.inc"/> <CursorPos X="15" Y="17"/> <TopLine Value="12"/> - <UsageCount Value="11"/> + <UsageCount Value="9"/> </Unit67> <Unit68> <Filename Value="../../../FPC/FPCCheckout/rtl/inc/objpash.inc"/> <CursorPos X="21" Y="184"/> - <TopLine Value="156"/> - <UsageCount Value="11"/> + <TopLine Value="167"/> + <UsageCount Value="14"/> </Unit68> + <Unit69> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="bitmaps"/> + <CursorPos X="33" Y="84"/> + <TopLine Value="74"/> + <EditorIndex Value="14"/> + <UsageCount Value="34"/> + <Loaded Value="True"/> + </Unit69> + <Unit70> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.pp"/> + <UnitName Value="FPCanvas"/> + <CursorPos X="96" Y="409"/> + <TopLine Value="188"/> + <UsageCount Value="10"/> + </Unit70> + <Unit71> + <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/colour.inc"/> + <CursorPos X="35" Y="9"/> + <TopLine Value="1"/> + <UsageCount Value="11"/> + </Unit71> + <Unit72> + <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/bitmap.inc"/> + <IsPartOfProject Value="True"/> + <CursorPos X="13" Y="43"/> + <TopLine Value="9"/> + <EditorIndex Value="9"/> + <UsageCount Value="33"/> + <Loaded Value="True"/> + </Unit72> + <Unit73> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.inc"/> + <CursorPos X="16" Y="20"/> + <TopLine Value="18"/> + <UsageCount Value="9"/> + </Unit73> + <Unit74> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/examples/drawing.pp"/> + <UnitName Value="Drawing"/> + <CursorPos X="20" Y="19"/> + <TopLine Value="1"/> + <UsageCount Value="9"/> + </Unit74> + <Unit75> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpimgcanv.pp"/> + <UnitName Value="FPImgCanv"/> + <CursorPos X="32" Y="23"/> + <TopLine Value="13"/> + <UsageCount Value="9"/> + </Unit75> + <Unit76> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fppixlcanv.pp"/> + <UnitName Value="FPPixlCanv"/> + <CursorPos X="3" Y="31"/> + <TopLine Value="32"/> + <UsageCount Value="9"/> + </Unit76> + <Unit77> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpimage.pp"/> + <UnitName Value="FPimage"/> + <CursorPos X="17" Y="129"/> + <TopLine Value="112"/> + <EditorIndex Value="15"/> + <UsageCount Value="14"/> + <Loaded Value="True"/> + </Unit77> + <Unit78> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpimage.inc"/> + <CursorPos X="3" Y="44"/> + <TopLine Value="40"/> + <EditorIndex Value="16"/> + <UsageCount Value="14"/> + <Loaded Value="True"/> + </Unit78> + <Unit79> + <Filename Value="../../../lazarus/lcl/lclintf.pas"/> + <UnitName Value="LCLIntf"/> + <CursorPos X="1" Y="1"/> + <TopLine Value="1"/> + <UsageCount Value="11"/> + </Unit79> + <Unit80> + <Filename Value="../../../lazarus/lcl/intfgraphics.pas"/> + <UnitName Value="IntfGraphics"/> + <CursorPos X="84" Y="1334"/> + <TopLine Value="1334"/> + <EditorIndex Value="19"/> + <UsageCount Value="14"/> + <Loaded Value="True"/> + </Unit80> + <Unit81> + <Filename Value="../../../lazarus/lcl/graphtype.pp"/> + <UnitName Value="GraphType"/> + <CursorPos X="19" Y="634"/> + <TopLine Value="630"/> + <EditorIndex Value="13"/> + <UsageCount Value="15"/> + <Loaded Value="True"/> + </Unit81> + <Unit82> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcolors.inc"/> + <CursorPos X="24" Y="21"/> + <TopLine Value="12"/> + <UsageCount Value="9"/> + </Unit82> + <Unit83> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fppalette.inc"/> + <CursorPos X="3" Y="19"/> + <TopLine Value="4"/> + <UsageCount Value="9"/> + </Unit83> + <Unit84> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fphandler.inc"/> + <CursorPos X="18" Y="268"/> + <TopLine Value="241"/> + <UsageCount Value="11"/> + </Unit84> + <Unit85> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpwritebmp.pp"/> + <UnitName Value="FPWriteBMP"/> + <CursorPos X="28" Y="722"/> + <TopLine Value="698"/> + <UsageCount Value="11"/> + </Unit85> + <Unit86> + <Filename Value="../../../lazarus/lcl/include/rasterimage.inc"/> + <CursorPos X="3" Y="571"/> + <TopLine Value="567"/> + <UsageCount Value="11"/> + </Unit86> + <Unit87> + <Filename Value="../../../lazarus/lcl/include/custombitmap.inc"/> + <CursorPos X="3" Y="98"/> + <TopLine Value="96"/> + <EditorIndex Value="22"/> + <UsageCount Value="13"/> + <Loaded Value="True"/> + </Unit87> + <Unit88> + <Filename Value="../../../Compilertje/Units/CogatUnits/compmaths.pas"/> + <UnitName Value="CompMaths"/> + <CursorPos X="26" Y="43"/> + <TopLine Value="14"/> + <UsageCount Value="10"/> + </Unit88> + <Unit89> + <Filename Value="../../../FPC/FPCCheckout/rtl/objpas/math.pp"/> + <UnitName Value="math"/> + <CursorPos X="1" Y="1"/> + <TopLine Value="1"/> + <EditorIndex Value="20"/> + <UsageCount Value="13"/> + <Loaded Value="True"/> + </Unit89> + <Unit90> + <Filename Value="../../../FPC/FPCCheckout/rtl/inc/systemh.inc"/> + <CursorPos X="11" Y="513"/> + <TopLine Value="496"/> + <EditorIndex Value="17"/> + <UsageCount Value="11"/> + <Loaded Value="True"/> + </Unit90> + <Unit91> + <Filename Value="../../../FPC/FPCCheckout/rtl/i386/fastmove.inc"/> + <CursorPos X="44" Y="836"/> + <TopLine Value="817"/> + <EditorIndex Value="18"/> + <UsageCount Value="11"/> + <Loaded Value="True"/> + </Unit91> </Units> <JumpHistory Count="30" HistoryIndex="29"> <Position1> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="125" Column="16" TopLine="95"/> + <Caret Line="132" Column="31" TopLine="106"/> </Position1> <Position2> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="15" Column="46" TopLine="15"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="107" Column="21" TopLine="100"/> </Position2> <Position3> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="131" Column="49" TopLine="95"/> + <Filename Value="../../../lazarus/lcl/intfgraphics.pas"/> + <Caret Line="274" Column="64" TopLine="251"/> </Position3> <Position4> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="125" Column="39" TopLine="110"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="30" Column="43" TopLine="28"/> </Position4> <Position5> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="129" Column="41" TopLine="123"/> + <Filename Value="../../Units/MMLCore/mufasatypes.pas"/> + <Caret Line="20" Column="12" TopLine="1"/> </Position5> <Position6> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="125" Column="22" TopLine="117"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="37" Column="54" TopLine="19"/> </Position6> <Position7> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="31" Column="17" TopLine="23"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="85" Column="5" TopLine="51"/> </Position7> <Position8> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="126" Column="13" TopLine="85"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="80" Column="26" TopLine="63"/> </Position8> <Position9> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="124" Column="7" TopLine="94"/> + <Caret Line="145" Column="17" TopLine="123"/> </Position9> <Position10> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="136" Column="6" TopLine="94"/> + <Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/> + <Caret Line="8" Column="30" TopLine="1"/> </Position10> <Position11> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="20" Column="19" TopLine="1"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="36" Column="60" TopLine="22"/> </Position11> <Position12> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="132" Column="1" TopLine="128"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="94" Column="67" TopLine="76"/> </Position12> <Position13> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="39" Column="36" TopLine="24"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="230" Column="5" TopLine="196"/> </Position13> <Position14> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="134" Column="43" TopLine="126"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="234" Column="22" TopLine="212"/> </Position14> <Position15> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="37" Column="57" TopLine="27"/> + <Filename Value="../../../lazarus/lcl/intfgraphics.pas"/> + <Caret Line="3242" Column="48" TopLine="3238"/> </Position15> <Position16> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="80" Column="29" TopLine="72"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="234" Column="9" TopLine="209"/> </Position16> <Position17> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="119" Column="42" TopLine="111"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="229" Column="19" TopLine="212"/> </Position17> <Position18> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="157" Column="36" TopLine="149"/> + <Filename Value="../../../lazarus/lcl/intfgraphics.pas"/> + <Caret Line="274" Column="64" TopLine="245"/> </Position18> <Position19> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="13" Column="132" TopLine="9"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="109" Column="39" TopLine="106"/> </Position19> <Position20> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="80" Column="73" TopLine="72"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="247" Column="36" TopLine="230"/> </Position20> <Position21> - <Filename Value="testunit.pas"/> - <Caret Line="44" Column="31" TopLine="9"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="223" Column="68" TopLine="201"/> </Position21> <Position22> - <Filename Value="../../Units/MMLCore/input.pas"/> - <Caret Line="203" Column="39" TopLine="187"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="225" Column="21" TopLine="202"/> </Position22> <Position23> - <Filename Value="../../Units/MMLCore/client.pas"/> - <Caret Line="30" Column="19" TopLine="1"/> + <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpimage.inc"/> + <Caret Line="194" Column="23" TopLine="168"/> </Position23> <Position24> - <Filename Value="../../Units/MMLCore/client.pas"/> - <Caret Line="31" Column="18" TopLine="1"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="219" Column="23" TopLine="196"/> </Position24> <Position25> - <Filename Value="../../Units/MMLCore/client.pas"/> - <Caret Line="32" Column="16" TopLine="1"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="211" Column="60" TopLine="196"/> </Position25> <Position26> - <Filename Value="../../Units/MMLCore/client.pas"/> - <Caret Line="33" Column="16" TopLine="1"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="230" Column="3" TopLine="206"/> </Position26> <Position27> - <Filename Value="../../Units/MMLCore/client.pas"/> - <Caret Line="30" Column="20" TopLine="1"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="233" Column="3" TopLine="206"/> </Position27> <Position28> - <Filename Value="testunit.pas"/> - <Caret Line="43" Column="32" TopLine="41"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="224" Column="60" TopLine="209"/> </Position28> <Position29> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="22" Column="54" TopLine="11"/> + <Filename Value="../../Units/MMLCore/bitmaps.pas"/> + <Caret Line="86" Column="5" TopLine="31"/> </Position29> <Position30> - <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> - <Caret Line="153" Column="18" TopLine="141"/> + <Filename Value="../../Units/MMLCore/client.pas"/> + <Caret Line="1" Column="38" TopLine="1"/> </Position30> </JumpHistory> </ProjectOptions> @@ -676,7 +848,7 @@ </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)/"/> - <OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/"/> + <OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/"/> </SearchPaths> <CodeGeneration> <Optimizations> diff --git a/Projects/SAMufasaGUI/project1.lpr b/Projects/SAMufasaGUI/project1.lpr index 3d596a9..ed34edf 100644 --- a/Projects/SAMufasaGUI/project1.lpr +++ b/Projects/SAMufasaGUI/project1.lpr @@ -8,7 +8,7 @@ uses {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset Forms, LResources, Window, files, MufasaTypes, Client, TestUnit, finder, - MMLThread, mmlpsthread; + MMLThread, mmlpsthread, bitmaps; {$IFDEF WINDOWS}{$R project1.rc}{$ENDIF} diff --git a/Tests/PS/SimpleBMPLoader.txt b/Tests/PS/SimpleBMPLoader.txt new file mode 100644 index 0000000..1272140 --- /dev/null +++ b/Tests/PS/SimpleBMPLoader.txt @@ -0,0 +1,142 @@ +program new; +var + Bmpz : integer; + w,h : integer; +begin + Bmpz := BitmapFromString(166, 73, 'beNq9Xf2PVeURtv+Jv' + + 'zeKSYvZaNlc2/S4N22tmtoYE0NsLdYQQoiClpgNQaSUUpRSpFhC/a' + + 'yIX0QCVaOtxn/MYWd39rnPM/Pecz/OJm82994958z7vjPvfM+c1ZW' + + 'f/+RHOtZWd9vwD/T7eLT7Fz+9z/7G17g+LrYfbdC99ks3mvil2/jF' + + 'nxDP8YfbX/8Q/8WB/wro9KM/wQbOKmau42f33W0Dv6aXLTgcCu6Dz' + + '6cbreDqYi3+tRttbm8nk9/YwxVcFG07ogORopitNieQjo/y22/jdH' + + 'XF1+W/2GSqDcSlxTPxK2IWf8Tf/bE+W7rXL/NpBDbjXzGlWMsD994' + + 'V0/av9//4h36N345LCFKfSjb+1bYlZuJoInTE8mPgj3qmcA8JOym+' + + 'cN8aBKm3IyycA36mVeMpUyaAvCJWFxfghPHk4i/+nDjODiKwr8tJ9' + + '6RappMBnan2EdYdwPXG79Vp8pl3gKBuch+QVXZbn4OQKozjw5Gpxv' + + 'Lj7LR5VEp46XEYC1U7cnFRSNXdJBuvzjiNlAD0PBIx0PRo2ElvnIV' + + 'YqX2wK20YkTxw7z1KKr5efxohTlGGHM9/jzl3k1JVT73OdvuYrK7E' + + 'mcJjiA8h5l8h/Y47fmCD7rVV2MLxmUFIKrDiAJIUoyuJ//sHh07iA' + + 'DnG2mgXbmyAQ25PqCGCj4MWk4wHOnRfrKNbBRnugBODajWpyDOx6J' + + 'cFxG5LsvtjHXqba5HqNZWZ00FG3NlwiKdOrR879kKAjusd41MB4ZT' + + 'wCJNAJ+lmHwh6XB+U01OhQloidpTO3KEo9IrPK08IZQznidgkVkAs' + + 'vRPoJAdRhCknVElHaNVrgrYN4jvvXPzyy+sXLpw+ePCZOOmhHaWaD' + + 'G0mcuyYACIa9Rn/VwVdNZlNGhjtIgVMgdq9D3d7/GuwZeWcSOcE3f' + + 'l2KgiC49FRIu0F7QvcBNyTCnolvGg/U2VeMY57hRA//+/H3377+Xf' + + 'ffXn16uX19cP2+z133tlHB8DT5PMhso+FE1fvAx0nEIBQptB+kgqR' + + '2hf+wD7Qg7E7n9c9JLUccYpfSbchXDfWTuoiYbzi2+lAiLduffjVV' + + '5/Z+PrrG///381vvrl1/vypI0cOOKn31PqQqvGr/+Kma0y1P/SKtF' + + 'SDVbQaN0AaS+m8J3RHcSA9JHhqgqH8IuwTrvuvvc3SKzmOS3aIN25' + + 'cNaA2jMy++OITG8ZbbALvvXfppZeec2JDo6yN9MAv2dG+XWt77o4l' + + '94eOoGMP8bA7OBSyZDlun7UNrW8m6JW2bBhfXbmLbEy1xJEe4mjPC' + + 'h3lAunGwTYrBIXINoifffafTz99+/r1d+2DDZvAzZsf4Bxee/WVo0' + + 'cPuTwNPKZKqdJe5WSYA/oYLFbaPdTYyX2UOvfmgI4ycbylaSvoCtG' + + 'I8bmhI64R47jViPRwfgZEA2fj2rUrNj766N+ffPyW/+JzsAn4HOxK' + + 'IzanNxLHhE3yppJvFsXWfNBRSJHninQGPBQdCL5FoJPrQP0D8TWsM' + + 'BJqC6499VeoDwcXHhANhA37YMO4x/vvv2HDtAWfQMzBJuBzOHv2Zb' + + 'cXnLfn7q8NXk2uP7xsKdDJzEdHRzdpCZJqscS1q+O0Kyy+IIDl7nx' + + 'YNx2gm7huQHS6+tcbr16+fO7Klb/beGXXbhs4B5tAzMFneODwkePH' + + '/2TDFQn1/boGizo5mttLhK6OtdQ1gadvudDVxVTpS0Rpi0NPfZUUf' + + 'kJc+9NMAzRbz8bFi2cuXTrrQG3YBN588x8xB5tAzMGneubM8RMnjj' + + 'qxdVtUTa5vFWRDQEcfMvJS1ZqGgI4SLXWhK09bInSV0Rh+cgKLh9i' + + 'NxiJsmD5w7tyfbfgcAjQOm8Pbb71uI8jv2UOHTp58yYa7H9EJluqi' + + 'vuQhoFO4p+K0A0FXp184xPAIDAS98rc7xh2oDyMSu8XMARunTx+jO' + + 'QQ4Jz8byHxiDnv37bN7bYTHm8LWqNcNCj3s4hTjOwBdRQmy1qF3Hu' + + '0RhG7/dRqzsb5+2BQAlwg+BxtKYEiBNgefhs3Br7fZGr0dXl8P/kZ' + + 'RLeKog0IPdI8zt97Q0FMHMmpNQ0OnUGwosXaBa4N2r1l2NkzV9znY' + + 'SLmKE6FRoBOhT9V+2f/c8w7RgaLqqBGTQPpw0MO9iV591G0GhZ4eM' + + 'Tz7Q0Mn5QGJzdUGG4cOPfv88/uPHDnw4osHbcQcfBoI2lmQz82gm7' + + 'ponxCiA628THHwh4OuerIGZAeFHhDJVAxKGA56GoQlu8wNPeMYBw7' + + '84eDBZ2zEHHwaPocgQvtg1GVkdvCFF43O0t1Gnx5yVEqjWjr0Kl8L' + + 'GU4Y5kuHHgycdiDNxxgCuqoQGkG2W9yyMwVg3769z/7xKRv79//e5' + + 'uDT8DkEEZqssRmmEOPJqCbpVzTTlgg9dR1TbGLbEbfhDlru2impEv' + + 'eZYuVB7cuCjjZ4h9HJjQQYNR/sXnfimaTYu/fx3z31xNNPP2lz8Gn' + + 'YHGwYUNMQTG0w9fLoiRPpelU51yNGF7ijb0HolE6gpzvNiY2DtiD0' + + 'cebKU1YTkfrlQsdMNs18IKU9uI09wcTD9evvmhbx+OOPPPHEb5588' + + 'rc2fA5GXSY7TDm8Haw5efKVV19TLqrqGaGbfFCktM8NHcP65N9Io5' + + 'ORTbcU6EjGGmkNvdH4iY34TI7lRdautJ3mMqW/2KNu3LhqWoSxjkc' + + 'f/aWNxx77tQkRM/HMCjCV0iZm5gESWJpVRYnllM6kccnY9lmh0wKR' + + 'e7cx7nyP/H6zQg8nj1r6uNjKXojb/bjNCl19p2H9UYSUQqXE2I2Eb' + + 't78wCSF8RPTEIzPGOHdzrU4derU+fMqNOkJGqTT0LPvCbm/5oBOt6' + + 'fqGQ7PqKfUGqS3WdeeUhpJzMCIJ0VgGgYZibNCxwRmzLdHesPT3Y3' + + 'y42CPvXXrQ9MizMS7fPnctWtXjv3ldAqRTlA7kYZQkIp1l2h9oKf+' + + '0tSxpnRVJaL0XztVu9A+B1ePCpRANGluIWEjkNR/5wODaTIPBoUpT' + + 'o3UGKs++89LpkWYvXD8r2dOX7igKoqWC6FnqZH3opusGJ8KPTXt0z' + + 'QDPEQVaMqPbUNHnoZZTMRh0LUb2lrci7FyrKroAx1v75q55WmeiZY' + + 'PhEx5+W9nz7x+MT1Zmp+GG6tFTMptiGBClQqSa0BXNSke8nC355Hx' + + 'A9XpJlyTQ2brXKy0oWMOW0U8eITTah3aQPJ4p9ArS7MT0Um+DlKck' + + 'C9R5Ut/Hk6qoLpZCAQhOjbK8EXhS1JH48mE1niUPeHhtdU+GCdNng' + + '6s4lp1YBLcPqWGVYgVeXg61I6reBqKg6hfIH2JHqhphEo2iEdcL6p' + + 'eeCOlYaep11WBoWoUOBz6r9buj+sp+1cTpRqCW8tbSOugu9CZQzdq' + + '9qljHOkQVaOHuhH63PrkkNO5rlCGWLv9qNWVdm1gNxnTSRWwqlI1K' + + 'q282MqzNBu1qFpnpL+0NS63ZO1z0EBsYJUH3lbVdA406KTEKm4jcW' + + '20uaWjXepONNTjoaZAkobsqzyooPPIvyVDTG1D4iHtKtFxpto1hqM' + + 'bzUycQ2od49ywiLKBcdITHN1YVY1ZgvHfNvHgw1NrWmM9qTmApwYL' + + 'WyiP0Y4eMoo0ESjVMVTPp0ic0uTm07bql1OMt4vO+pfDp7o3kXHVD' + + 'aCqQ0n9dQ2FXOuVGuhO3QI53je4JZWfO7r9A1Wya8uFVMdrgE6rBq' + + 'I4tJLIOmftMDB3uwNlMunGqozQPdGVpkzYU3zxOIeShviNY94Q7lM' + + 'NdtQP0RAj9QmtUdTE1LOtx7mVi7W6knLaiVOwFRmZOrRItiofSOtq' + + 'kyK+1U1fZapBYeFzGpuumHn8yzGo/MGGYTxkejcZEdMz1ZPP096Se' + + 'kxSspJBMWfc5MYR3jQ0HhxRHLkS1rMOtc6matpUBalOvAYGlQ9oYm' + + '3IvoYGFdjvpFTcy4V6FnrQZcT8FeOoFronraF7pPUI0R0l9Hb1tKe' + + 'hTNRSGiyLOnVUZYxVMxPtylI1WplaOYX71okKRLen8i69nm40Mpjp' + + 'CCjG00YEVKRDJwLVM53zVA+/lu5WTYd6HvCUTpTOUWmsdIxGgLub5' + + 'GzjQvHGE03KEpFTpYegOUZtARr0pn1j4smuAFSIJiJUryntiSJdu1' + + 'XgcGrRKmMvPDc7VyvNMRJEa0T5i9XxarWRzw0/NwRBVQZL6lk36cf' + + 'WoAmFzmPa1amJM9XgLUo/xk4rvR1X1HDRR3yqUrQqNSy2VC82evPl' + + 'uPbVqGKgxzYal5E3jEhOufpUjHegf3Yjflr0gdHyzCotQbNQsDdUm' + + '4kRb4k+MKm20MiTJ7OlYdapCa/QdaXsZlzdluboT1aFJwwx9Rt4oz' + + 'Cs7PBSiLQ/W7rnVVw17bcThqdW8UcvFFTkqFdDugT1SaKWgh4VNdL' + + 'TXihpjpOmU2p8x2HhrMw6I9Tg8xU6hVdiK1wJ3+o3ck/KdV2jS/MD' + + 'cVZBNgSd1OzKWK5ccIjTShtvdCNpkFyFi4pRV2GRNvSGF6tyOaItH' + + 'Dc+tDYibzkWJCr0EKM0W7Tr0T9J14R1lnKkuL7RAwePUlAIAaq6Em' + + 'lmi3ZYqrqRbJ7u0a7UzQJF09tGdFpHTy5TLGlvQE+tsKl9tCq3Hkb' + + 'E+nRioVCgE4w/BHlXJWsq1bFnFxoNEum5a3QiDWRhUnffPjBbaXtu' + + 'iqLTG/NhUmHhe6Ue8p7QSY9Now8N46JSXHtCD19QPCeQbvwKsZ/6u' + + 'NSon2nnNa6hXru00SJtTqTX9u9GMs76laW9lVI/z6YqO5mMNFMXGt' + + 'KiQ13pad7S9GZdOybKBsZxYAkYCtNKhM269j7xODrXaWV3/24k5Fq' + + 'MNstkTWv6dOio2jOhP3SyONIOimgXd/UBn68LDfIQ5O2EdMqWIeXB' + + 'xnwdeHRv04586KsJ4lykGwlG4dXQrhLmqbB6kU4sbZeUhryrrjtz9' + + '8BRzWSbw4MJoLNacOfbqgsVyChtL9iJBZuIVm4QZTtLgZ6mHERqAd' + + 'YXo58Hd3vBTixVP4qGKr6stVNCGmGcxOgSu5F0PXzmWhSzxC405NX' + + 'R7isVD18cugaMXGZNuEwhQW650DVomyaWD9GNZDt8LIYhGWsDQU/D' + + 'lBjhJTpfLvR2ly2sNByiC00aQQsaGK4bSdWAhbwKA3ViodBP6O3Yh' + + 'XXQLjSaP4wN9ofrA9NO8hy6G0kjpBvoHgg6RTAxjukm/86vHcXZzq' + + 'xdc/Z2oA8MURpVTw8KHeNumsOzA2tHc4wy7Xdy51VpGboPTDBS8rA' + + 'NDT38OZpNFCQ36No1IuM/uum9YzuPPgcDPVw3EordY5tcrHQbFDrl' + + 'wpEjaAegN/Jmh4PuvIX81T6H8PAsvRuJpuph50AKvC4XejtHCDmMH' + + 'cAdgJ6i25n8ENAb9XeI8WV1IyF/KeUeaHGrq6xL7MQSaa601eFZ1Y' + + 'O23D4wtOGVzbL0ne+Z7BeqxVK6kWhRDKGbCiswGriULjSNw4Up7lo' + + '5viB0xDJ+Jsc+7bkT4RLX3o1miBMt2I2ky7I605qItBB1QeiNMiKK' + + 'yqVVUYtAx0hoO72qiowv3oWm6rmU1sLQwhfvA6MZsFVlBCV0zd0Lh' + + 'bIKVYVo1J7E8Z+vC02Fa1xa9YKYyHdyTWa+HjhVonvF7jRiNV8nlr' + + 'RYhmIZ8T7T9P0vc3RiqXKoFG5Dc0N6mxV6zx4FE+9mgoowN5QC4zN' + + 'BD7iaAtEI2aTJCTP1QtHsxKpUaqIbxlbxo6ag9O+FUlUjpmmQyNJV' + + 'l4vY9ExdaG43KNgY6bkeQ1JEo04ZWUR/6A0JUq0O31yjpN7uRlLle' + + 'NP7NOnh6TvsNP11KvR2Sc7UKjNtKzHr2isjSys+MAhLMfGwi2+nr2' + + '/pk1Ohk/tOMz/7hGW12r3RiSUqpjVhjN615P/VupUgRX29whhex1l' + + 'B71n/m7YG1d4jlftxahcafCYx9mpXKfulwlobOuXL+WfNuW0jXfM0' + + 'MPtd22/qi+bbZeZpvZKmK5BKk0qQIBgV2VXWgdKb/kvvTbmobqkTv' + + '/6L3ihtw9SzFOOb7tYt5Q2Dp7rzrubFc+yzj3imf527htpMSNWOcL' + + 'ejGx51C0lFuRbU42O1pCs6sYQzp9FGoErtbltqVfEIdqEhaev8AbO' + + 'R22+lRJUS0U32hStvSAPbmuGDo+rwOnIDxRW625Xm2lWyLSMmurRJ' + + 'U4LIc4voSVrUGRjfPBRb1VjY7gwba2hrDnrlaFqzlpYcTrTNaa4un' + + 'rOdgbznbsxWavQ/ieNJF2DxC0pn/7xJYw+OpoqhqTWnU7Pi1UEUOl' + + 'gIHX+Nr7duoP7h1DRsgsNPqrLaZU5zk+IlZZqSN5YCh9QUjWhpN6l' + + 'm9FFyQuWIWhU84FUOdspksM4okml9bq4J+EmnE61lUI0J69vEdNUq' + + 'Q4lZpZG+tLhS++s2ClLUXE21Aqzg7ia7J6X1renO0Bmvuv8lGs5W3' + + 'xXcE6wyaNQKRduHgE6sW/fWSSLdbfWcTFXPsNJ5LO9wTAveUxcxvf' + + 'WV6psUv423Syd8dbLrO/HqwPu2RiQSilKMegawti01UJtJ3w4iIe2' + + 'ry1KUA7kh/QmPgetGv8Ew37Q1Qa9uRUUfsEZibUP/SZ1saRd9dbv1' + + 'gZVSTtuVpMt0PkzqE5VETZWA9ORAYtxORWo4HJuqd6EyhpGdBsanM' + + 'pM+fH7qXVRxSZ6WbsS9QJMebtBVLH1PqzZk07pdJOxutBsNn0huof' + + '6H6avb2+2V0KYgqUdS1VFABNOoOkm3FI98BHDT0ADJgrLZi5G3j3a' + + 'Po+8BCV1cWQ=='); + GetBitmapSize(bmpz,w,h); + Writeln(inttostr(w) + '-' + inttostr(h)); + SetBitmapSize(Bmpz,w div 2, h div 2); + SaveBitmap(Bmpz,'c:\Test.bmp'); + FreeBitmap(Bmpz); + Bmpz := LoadBitmap('c:\Test.bmp'); + SetBitmapSize(bmpz,w,h); + SaveBitmap(Bmpz,'c:\Test2.bmp'); +end. \ No newline at end of file diff --git a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc new file mode 100644 index 0000000..3e0c034 --- /dev/null +++ b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc @@ -0,0 +1,44 @@ +function CreateBitmap(w,h : integer):integer; +begin + result := CurrThread.Client.MBitmaps.CreateBMP(w,h); +end; + +procedure FreeBitmap(Number : integer); +begin + CurrThread.Client.MBitmaps.FreeBMP(Number); +end; + +procedure SaveBitmap(Bmp : integer; path : string); +begin; + CurrThread.Client.MBitmaps.Bmp[Bmp].SaveToFile(Path); +end; + +function BitmapFromString(Width,height : integer; Data : string) : integer; +begin; + Result := CurrThread.Client.MBitmaps.CreateBMPFromString(Width,Height,Data); +end; + +function LoadBitmap(Path : String) : integer; +begin; + Result := CurrThread.Client.MBitmaps.CreateBMPFromFile(Path); +end; + +procedure SetBitmapSize(Bmp,NewW,NewH : integer); +begin; + if (NewW>=0) and (NewH >=0) then + CurrThread.Client.MBitmaps.Bmp[Bmp].SetSize(NewW,NewH); +end; + +procedure GetBitmapSize(Bmp : integer; var BmpW,BmpH : integer); +begin; + With CurrThread.Client.MBitmaps.Bmp[bmp] do + begin; + BmpW := width; + BmpH := Height; + end; +end; + +function CreateMirroredBitmap(Bmp : integer) : integer; +begin; + Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp); +end; diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index 1d4d7e1..5651280 100644 --- a/Units/MMLAddon/PSInc/pscompile.inc +++ b/Units/MMLAddon/PSInc/pscompile.inc @@ -1,4 +1,13 @@ -Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); -Sender.AddFunction(@psWriteln,'procedure writeln(s : string);'); -Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); -Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);'); +Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); +Sender.AddFunction(@psWriteln,'procedure writeln(s : string);'); +Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); +Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);'); +Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;'); +Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);'); +Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);'); +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;'); + diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 702d720..fc2ad8c 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -1,257 +1,250 @@ -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; - 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 OnThreadTerminate(Sender: TObject); - procedure Execute; override; - public - Client : TClient; - procedure SetPSScript(Script : string); - procedure SetDebug( Strings : TSynMemo ); -// function CompilePSScript : boolean; -// function - constructor Create(CreateSuspended: Boolean); - destructor Destroy; override; - 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 - - lclintf; // for GetTickCount and others. - - -threadvar - CurrThread : TMMLPSThread; - -{Some General PS Functions here} -procedure psWriteln(str : string); -begin - writeln(str); - {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 } - - // ^ Every time a script is compiled, a new thread is created. There will no - // existing client left. I commented the above code out. - Client := TClient.Create; - - { if PSScript <> nil then - PSScript.Free; } - // ^ Same, makes no sense. :-) - - // 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; - - // Set some defines - {$I PSInc/psdefines.inc} - - FreeOnTerminate := True; - Self.OnTerminate := @Self.OnThreadTerminate; - inherited Create(CreateSuspended); -end; - -procedure TMMLPSThread.OnThreadTerminate(Sender: TObject); -begin -// Writeln('Terminating the thread'); -end; - -destructor TMMLPSThread.Destroy; -begin - Client.Free; - PSScript.Free; - inherited; -end; - -// include PS wrappers - -{$I PSInc/Wrappers/colour.inc} - - -procedure TMMLPSThread.OnCompile(Sender: TPSScript); -begin - //Here we add all the initalizing, of BMPArray etc - - // ^ This will all be done with Client.Create; - - // Here we add all the functions to the engine. - {$I PSInc/pscompile.inc} -end; - -procedure TMMLPSThread.AfterExecute(Sender: TPSScript); -begin - //Here we add all the Script-freeing-leftovers (like BMParray etc) - // ^ This will all be done with Client.Destroy; -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 := lclintf.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; - - -{ Include stuff here? } - -//{$I inc/colors.inc} -//{$I inc/bitmaps.inc} - - -end. - - +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; + 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 OnThreadTerminate(Sender: TObject); + procedure Execute; override; + public + Client : TClient; + procedure SetPSScript(Script : string); + procedure SetDebug( Strings : TSynMemo ); +// function CompilePSScript : boolean; +// function + constructor Create(CreateSuspended: Boolean); + destructor Destroy; override; + 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 + + lclintf; // for GetTickCount and others. + + +threadvar + CurrThread : TMMLPSThread; + +{Some General PS Functions here} +procedure psWriteln(str : string); +begin + {$IFNDEF MSWINDOWS} + writeln(str); + {$ELSE} + if CurrThread.DebugTo <> nil then + CurrThread.DebugTo.Lines.Add(Str); + {$ENDIF} + //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 + Client := TClient.Create; + PSScript := TPSScript.Create(nil); + PSScript.UsePreProcessor:= True; + PSScript.OnNeedFile := @RequireFile; + + PSScript.OnCompile:= @OnCompile; + PSScript.OnCompImport:= @OnCompImport; + PSScript.OnExecImport:= @OnExecImport; + PSScript.OnAfterExecute:= @AfterExecute; + + // Set some defines + {$I PSInc/psdefines.inc} + + FreeOnTerminate := True; + Self.OnTerminate := @Self.OnThreadTerminate; + inherited Create(CreateSuspended); +end; + +procedure TMMLPSThread.OnThreadTerminate(Sender: TObject); +begin +// Writeln('Terminating the thread'); +end; + +destructor TMMLPSThread.Destroy; +begin + Client.Free; + PSScript.Free; + inherited; +end; + +// include PS wrappers +{$I PSInc/Wrappers/bitmap.inc} + +{$I PSInc/Wrappers/colour.inc} + + + + +procedure TMMLPSThread.OnCompile(Sender: TPSScript); +begin + //Here we add all the initalizing, of BMPArray etc + + // ^ This will all be done with Client.Create; + + // Here we add all the functions to the engine. + {$I PSInc/pscompile.inc} +end; + +procedure TMMLPSThread.AfterExecute(Sender: TPSScript); +begin + //Here we add all the Script-freeing-leftovers (like BMParray etc) + // ^ This will all be done with Client.Destroy; +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 + psWriteln(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 := lclintf.GetTickCount; + try + if PSScript.Compile then + begin + OutputMessages; + psWriteln('Compiled succesfully in ' + IntToStr(GetTickCount - time) + ' ms.'); +// if not (ScriptState = SCompiling) then + if not PSScript.Execute then + begin +// FormMain.CurrSynEdit.SelStart := Script.PSScript.ExecErrorPosition; + psWriteln(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.' + +Inttostr(PSScript.ExecErrorByteCodePosition)); + end else psWriteln('Succesfully executed'); + end else + begin + OutputMessages; + psWriteln('Compiling failed'); + 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: TSynMemo); +begin + DebugTo := Strings; +end; + + +{ Include stuff here? } + +//{$I inc/colors.inc} +//{$I inc/bitmaps.inc} + + +end. + + diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas new file mode 100644 index 0000000..7f2c0e7 --- /dev/null +++ b/Units/MMLCore/bitmaps.pas @@ -0,0 +1,322 @@ +unit bitmaps; + +{$mode objfpc}{$H+} + +interface +uses + Classes, SysUtils, FPImgCanv,FPImage,IntfGraphics,graphtype,MufasaTypes ,graphics; + +type + + { TMufasaBitmap } + + TMufasaBitmap = class(TObject) + private + w,h : integer; + public + FData : PRGB32; + procedure SetSize(AWidth,AHeight : integer); + property Width : Integer read w; + property Height : Integer read h; + function SaveToFile(const FileName : string) :boolean; + procedure LoadFromFile(const FileName : string); + constructor Create; + destructor Destroy;override; + + end; + TMufasaBmpArray = Array of TMufasaBitmap; + { TMBitmaps } + TMBitmaps = class(TObject) + protected + Client : TObject; + FreeSpots : Array of integer; + BmpArray : TMufasaBmpArray; + BmpsCurr,BmpsHigh,FreeSpotsHigh,FreeSpotsLen : integer; + public + function GetBMP(Index : integer) : TMufasaBitmap; + property Bmp[Index : integer]: TMufasaBitmap read GetBMP; + function CreateBMP(w, h: integer): Integer; + function CreateMirroredBitmap(bitmap: Integer): Integer; + function CreateBMPFromFile(const Path : string) : integer; + function CreateBMPFromString(width,height : integer; Data : string) : integer; + procedure FreeBMP( Number : integer); + constructor Create(Owner : TObject); + destructor Destroy;override; + end; + + +implementation + +uses + Windowutil,paszlib,DCPbase64; +{ TMBitmaps } + + +function TMBitmaps.GetBMP(Index: integer): TMufasaBitmap; +begin + if (Index >= 0) and (Index <= BmpsCurr) then + if BmpArray[Index] <> nil then + Result := BmpArray[Index]; +end; + +function TMBitmaps.CreateBMP(w,h : integer): Integer; +begin; + if BmpsCurr < BmpsHigh then + begin; + inc(BmpsCurr); + Result := BmpsCurr; + end else if (FreeSpotsHigh > -1) then + begin; + Result := FreeSpots[FreeSpotsHigh]; + dec(FreeSpotsHigh); + end else + begin; + SetLength(BmpArray, BmpsHigh + 6); + BmpsHigh := BmpsHigh + 5; + inc(BmpsCurr); + Result := BmpsCurr; + end; + BmpArray[Result] := TMufasaBitmap.Create; + BmpArray[Result].SetSize(w,h); +end; + +function TMBitmaps.CreateMirroredBitmap(bitmap: Integer): Integer; +var + w,h : integer; + y,x : integer; + Source,Dest : PRGB32; +begin; + Source := Bmp[Bitmap].FData; + w := BmpArray[Bitmap].Width; + h := BmpArray[Bitmap].Height; + Result := CreateBMP(w,h); + Dest := BmpArray[Result].FData; + for y := (h-1) downto 0 do + for x := (w-1) downto 0 do + Dest[y*w+x] := Source[y*w+w-1-x]; +//Can be optmized, this is just proof of concept +end; + +function TMBitmaps.CreateBMPFromFile(const Path: string): integer; +begin + Result := CreateBMP(0,0); + BmpArray[result].LoadFromFile(Path); +end; + +function HexToInt(HexNum: string): LongInt;inline; +begin + Result:=StrToInt('$' + HexNum); +end; + +function TMBitmaps.CreateBMPFromString(width, height: integer; Data: string): integer; +var + I,II,x,y: LongWord; + DestLen : LongWord; + Dest,Source : string; + DestPoint, Point : PByte; + LazIntf : TLazIntfImage; + +begin; + Result := CreateBMP(width,height); + if (Data <> '') and (Length(Data) <> 6) then + begin; + Point := Pointer(BmpArray[Result].FData); + if Data[1] = 'b' then + begin; + Source := Base64DecodeStr(Copy(Data,2,Length(Data) - 1)); + Destlen := Width * Height * 3; + Setlength(Dest,DestLen); + if uncompress(PChar(Dest),Destlen,pchar(Source), Length(Source)) = Z_OK then + begin; + DestPoint := @Dest[1]; + i := 0; + ii := 2; + Dec(DestLen); + if DestLen > 2 then + begin; + while (ii < DestLen) do + Begin; + Point[i]:= DestPoint[ii+2]; + Point[i+1]:= DestPoint[ii+1]; + Point[i+2]:= DestPoint[ii]; + ii := ii + 3; + i := i + 4; + end; + Point[i] := DestPoint[1]; + Point[i+1] := DestPoint[0]; + Point[i+2] := DestPoint[ii]; + end else if (Width = 1) and (Height =1 ) then + begin; + Point[0] := DestPoint[1]; + Point[1] := DestPoint[0]; + Point[2] := DestPoint[2]; + end; + end; + end else if Data[1] = 'z' then + begin; + Destlen := Width * Height * 3 *2; + Setlength(Dest,DestLen); + ii := (Length(Data) - 1) div 2; + SetLength(Source,ii); + for i := 1 to ii do + Source[i] := Chr(HexToInt(Data[i * 2] + Data[i * 2+1])); + if uncompress(PChar(Dest),Destlen,pchar(Source), ii) = Z_OK then + begin; + ii := 1; + i := 0; + while (II < DestLen) do + begin; + Point[i+2]:= HexToInt(Dest[ii] + Dest[ii + 1]); + Point[i+1]:= HexToInt(Dest[ii+2] + Dest[ii + 3]); + Point[i]:= HexToInt(Dest[ii+4] + Dest[ii + 5]); + ii := ii + 6; + i := i + 4; + end; + end; + end else if LongWord(Length(Data)) = (Width * Height * 3 * 2) then + begin; + ii := 1; + i := 0; + Destlen := Width * Height * 3 * 2; + while (II < DestLen) do + begin; + Point[i+2]:= HexToInt(Data[ii] + Data[ii + 1]); + Point[i+1]:= HexToInt(Data[ii+2] + Data[ii + 3]); + Point[i]:= HexToInt(Data[ii+4] + Data[ii + 5]); + ii := ii + 6; + i := i + 4; + end; + end; + end else + begin; +{ if Length(data) = 6 then + FastDrawClear(Result,HexToInt(Data)) + else + Bmps[Result].Canvas.Rectangle(0,0,Width-1,Height-1);} + end; +end; + +procedure TMBitmaps.FreeBMP(Number: integer); +begin; + if Number = BmpsCurr then + Dec(BmpsCurr) + else + begin; + inc(FreeSpotsHigh); + if FreeSpotsHigh = FreeSpotsLen then + begin; + inc(FreeSpotsLen); + SetLength(FreeSpots, FreeSpotsLen); + end; + FreeSpots[FreeSpotsHigh] := Number; + end; + BmpArray[Number].Free; +end; + +function TMufasaBitmap.SaveToFile(const FileName: string): boolean; +var + rawImage : TRawImage; + Bmp : TLazIntfImage; +begin + ArrDataToRawImage(FData,Point(w,h),RawImage); +// Bmp := Graphics.TBitmap.Create; + Bmp := TLazIntfImage.Create(RawImage,true); + Bmp.SaveToFile(FileName); + Bmp.Free; +end; + +procedure TMufasaBitmap.LoadFromFile(const FileName: string); +var + LazIntf : TLazIntfImage; + RawImageDesc : TRawImageDescription; +begin + if FileExists(FileName) then + begin; + LazIntf := TLazIntfImage.Create(0,0); + RawImageDesc.Init_BPP32_B8G8R8_BIO_TTB(LazIntf.Width,LazIntf.Height); + LazIntf.DataDescription := RawImageDesc; + LazIntf.LoadFromFile(FileName); + if Assigned(FData) then + Freemem(FData); + Self.W := LazIntf.Width; + Self.H := LazIntf.Height; + FData := GetMem(Self.W*Self.H*SizeOf(TRGB32)); + Move(LazIntf.PixelData[0],FData[0],w*h*sizeOf(TRGB32)); + LazIntf.Free; + end; +end; + +constructor TMBitmaps.Create(Owner: TObject); +begin + inherited Create; + SetLength(BmpArray,50); + SetLength(FreeSpots, 50); + FreeSpotsLen := 50; + BmpsHigh := 49; + BmpsCurr := -1; + FreeSpotsHigh := -1; + Self.Client := Owner; +end; + +destructor TMBitmaps.Destroy; +begin + + inherited Destroy; +end; + + +{ TMufasaBitmap } +function Min(a,b:integer) : integer; +begin; + if a < b then + result := a + else + result := b; +end; + +procedure TMufasaBitmap.SetSize(Awidth, Aheight: integer); +var + NewData : PRGB32; + i,minw,minh : integer; +begin + if (AWidth <> w) or (AHeight <> h) then + begin; + if AWidth*AHeight <> 0 then + begin; + NewData := GetMem(AWidth * AHeight * SizeOf(TRGB32)); + FillDWord(NewData[0],AWidth*AHeight,0); + end + else + NewData := nil; + if Assigned(FData) and Assigned(NewData) and (w*H <> 0) then + begin; + minw := Min(AWidth,w); + minh := Min(AHeight,h); + for i := 0 to minh - 1 do + Move(FData[i*w],Newdata[i*AWidth],minw * SizeOf(TRGB32)); + end; + if Assigned(FData) then + FreeMem(FData); + FData := NewData; + w := AWidth; + h := AHeight; + end; +end; + +constructor TMufasaBitmap.Create; +begin + inherited Create; + FData:= nil; + w := 0; + h := 0; +end; + +destructor TMufasaBitmap.Destroy; +begin + if Assigned(FData) then + Freemem(FData,w*h*SizeOf(TRGB32)); + inherited Destroy; +end; + +end. + diff --git a/Units/MMLCore/client.pas b/Units/MMLCore/client.pas index 9e560c5..84bb6e4 100644 --- a/Units/MMLCore/client.pas +++ b/Units/MMLCore/client.pas @@ -5,7 +5,7 @@ unit Client; interface uses - Classes, SysUtils, MufasaTypes, Window, Input, Files, Finder; + Classes, SysUtils, MufasaTypes, Window, Input, Files, Finder,Bitmaps; type TClient = class(TObject) @@ -17,6 +17,7 @@ type MInput: TMInput; MFiles: TMFiles; MFinder: TMFinder; + MBitmaps : TMBitmaps; end; @@ -31,10 +32,12 @@ begin MInput := TMInput.Create(Self); MFiles := TMFiles.Create; MFinder := TMFinder.Create(Self); + MBitmaps := TMBitmaps.Create(self); end; destructor TClient.Destroy; begin + MBitmaps.Free; MFinder.Free; MFiles.Free; MInput.Free; diff --git a/Units/Misc/dcpbase64.pas b/Units/Misc/dcpbase64.pas new file mode 100644 index 0000000..5a2472d --- /dev/null +++ b/Units/Misc/dcpbase64.pas @@ -0,0 +1,140 @@ +{******************************************************************************} +{* DCPcrypt v2.0 written by David Barton (crypto@cityinthesky.co.uk) **********} +{******************************************************************************} +{* A Base64 encoding/decoding unit ********************************************} +{******************************************************************************} +{* Copyright (c) 1999-2002 David Barton *} +{* Permission is hereby granted, free of charge, to any person obtaining a *} +{* copy of this software and associated documentation files (the "Software"), *} +{* to deal in the Software without restriction, including without limitation *} +{* the rights to use, copy, modify, merge, publish, distribute, sublicense, *} +{* and/or sell copies of the Software, and to permit persons to whom the *} +{* Software is furnished to do so, subject to the following conditions: *} +{* *} +{* The above copyright notice and this permission notice shall be included in *} +{* all copies or substantial portions of the Software. *} +{* *} +{* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *} +{* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *} +{* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *} +{* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *} +{* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *} +{* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *} +{* DEALINGS IN THE SOFTWARE. *} +{******************************************************************************} +unit DCPbase64; + +{$mode delphi} +interface +uses + Sysutils; + +function Base64EncodeStr(const Value: string): string; + { Encode a string into Base64 format } +function Base64DecodeStr(const Value: string): string; + { Decode a Base64 format string } +function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint; + { Encode a lump of raw data (output is (4/3) times bigger than input) } +function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint; + { Decode a lump of raw data } + + +{******************************************************************************} +{******************************************************************************} +implementation + + +const + B64: array[0..63] of byte= (65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80, + 81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108, + 109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53, + 54,55,56,57,43,47); + +function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint; +var + i, iptr, optr: integer; + Input, Output: PByteArray; +begin + Input:= PByteArray(pInput); Output:= PByteArray(pOutput); + iptr:= 0; optr:= 0; + for i:= 1 to (Size div 3) do + begin + Output^[optr+0]:= B64[Input^[iptr] shr 2]; + Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)]; + Output^[optr+2]:= B64[((Input^[iptr+1] and 15) shl 2) + (Input^[iptr+2] shr 6)]; + Output^[optr+3]:= B64[Input^[iptr+2] and 63]; + Inc(optr,4); Inc(iptr,3); + end; + case (Size mod 3) of + 1: begin + Output^[optr+0]:= B64[Input^[iptr] shr 2]; + Output^[optr+1]:= B64[(Input^[iptr] and 3) shl 4]; + Output^[optr+2]:= byte('='); + Output^[optr+3]:= byte('='); + end; + 2: begin + Output^[optr+0]:= B64[Input^[iptr] shr 2]; + Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)]; + Output^[optr+2]:= B64[(Input^[iptr+1] and 15) shl 2]; + Output^[optr+3]:= byte('='); + end; + end; + Result:= ((Size+2) div 3) * 4; +end; + +function Base64EncodeStr(const Value: string): string; +begin + SetLength(Result,((Length(Value)+2) div 3) * 4); + Base64Encode(@Value[1],@Result[1],Length(Value)); +end; + +function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint; +var + i, j, iptr, optr: integer; + Temp: array[0..3] of byte; + Input, Output: PByteArray; +begin + Input:= PByteArray(pInput); Output:= PByteArray(pOutput); + iptr:= 0; optr:= 0; + Result:= 0; + for i:= 1 to (Size div 4) do + begin + for j:= 0 to 3 do + begin + case Input^[iptr] of + 65..90 : Temp[j]:= Input^[iptr] - Ord('A'); + 97..122: Temp[j]:= Input^[iptr] - Ord('a') + 26; + 48..57 : Temp[j]:= Input^[iptr] - Ord('0') + 52; + 43 : Temp[j]:= 62; + 47 : Temp[j]:= 63; + 61 : Temp[j]:= $FF; + end; + Inc(iptr); + end; + Output^[optr]:= (Temp[0] shl 2) or (Temp[1] shr 4); + Result:= optr+1; + if (Temp[2]<> $FF) and (Temp[3]= $FF) then + begin + Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2); + Result:= optr+2; + Inc(optr) + end + else if (Temp[2]<> $FF) then + begin + Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2); + Output^[optr+2]:= (Temp[2] shl 6) or Temp[3]; + Result:= optr+3; + Inc(optr,2); + end; + Inc(optr); + end; +end; + +function Base64DecodeStr(const Value: string): string; +begin + SetLength(Result,(Length(Value) div 4) * 3); + SetLength(Result,Base64Decode(@Value[1],@Result[1],Length(Value))); +end; + + +end.