diff --git a/Doc/sphinx/conf.py b/Doc/sphinx/conf.py index 14cf164..a19d61b 100644 --- a/Doc/sphinx/conf.py +++ b/Doc/sphinx/conf.py @@ -48,9 +48,9 @@ copyright = u'2010, Merlijn Wajer, Raymond van Venetie' # built documents. # # The short X.Y version. -version = '0.810' +version = '0.97' # The full version, including alpha/beta/rc tags. -release = '0.810' +release = '0.97' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. @@ -94,7 +94,7 @@ pygments_style = 'sphinx' # The theme to use for HTML and HTML Help pages. Major themes that come with # Sphinx are currently 'default' and 'sphinxdoc'. -html_theme = 'default' +html_theme = 'nature' # Theme options are theme-specific and customize the look and feel of a theme # further. For a list of options available for each theme, see the @@ -176,7 +176,7 @@ htmlhelp_basename = 'Simbadoc' # (source start file, target name, title, author, documentclass [howto/manual]). latex_documents = [ ('index', 'Simba.tex', u'Simba Documentation', - u'Merlijn Wajer, Raymond van Venetie', 'manual'), + u'Merlijn Wajer, Raymond van Venetië, Nielsie95', 'manual'), ] # The name of an image file (relative to this directory) to place at the top of diff --git a/Doc/sphinx/docdoc.rst b/Doc/sphinx/docdoc.rst index 1f8655e..f86af9d 100644 --- a/Doc/sphinx/docdoc.rst +++ b/Doc/sphinx/docdoc.rst @@ -1,7 +1,9 @@ +.. _docdoc: + Documentation Documentation =========================== -This page is the documentation for the documentation. +This page is the documentation for the documentation. It is very important to know this by heart when you are writing documentation for Simba. @@ -18,12 +20,13 @@ be found at the bottom of the page. Building the documentation -------------------------- + In the future, the online documentation will be refreshed every hour. However, if you want to build the documentation yourself, you should install -``python-sphinx``. +``python-sphinx``. -Move to the ``Simba/doc/sphinx`` directory and run ``make all``. -This will place an HTML version of the documentation in ``_build/html``. +Move to the ``Simba/doc/sphinx`` directory and run ``make all``. +This will place an HTML version of the documentation in ``_build/html``. .. note:: The build instructions are for Linux only. If you want to build the doc on @@ -66,6 +69,28 @@ The titles of all major sections have all words capitalized. (The ones with The minor sections and subsections (---) and (~~~) have only the first word and Simba specific words (like Simba itself) capitalized. -Try to stick to the Python documentation standards. +Try to stick to the Python documentation standards. ( http://docs.python.org/using/index.html ) +References +---------- + +Sphinx has references, most of the .rst files contain labels and references. + +A label looks something like this: + +.. code-block:: python + + .. _-: + +Where X is either the name of file or folder; and Y is the name of the +file/function if X is a folder. For referring to specific functions for example, +use: + +.. code-block:: python + + .. _scriptref-movemouse: + +To define a label for the MoveMouse function. Labels are always placed right +above section/chapter declarations. + diff --git a/Doc/sphinx/features.rst b/Doc/sphinx/features.rst index 489ee1c..12aea5b 100644 --- a/Doc/sphinx/features.rst +++ b/Doc/sphinx/features.rst @@ -1,7 +1,11 @@ -Feature Overview -================ +Detailed Feature Overview +========================= + +Simba has some fancy features; the most basic operations as well as detailed +information about settings will be explained here. .. toctree:: + :maxdepth: 2 features/scriptmanager.rst features/autoupdate.rst @@ -10,5 +14,3 @@ Feature Overview features/ui.rst features/notwellknown.rst - -Most stuff here is probably misplaced anyway. diff --git a/Doc/sphinx/features/notwellknown.rst b/Doc/sphinx/features/notwellknown.rst index c7be836..fe9806d 100644 --- a/Doc/sphinx/features/notwellknown.rst +++ b/Doc/sphinx/features/notwellknown.rst @@ -1,6 +1,9 @@ Not Well Known Features ======================= +.. + TODO + Simba has several features that are relatively unknown. A few will be listed here. diff --git a/Doc/sphinx/gettingstarted.rst b/Doc/sphinx/gettingstarted.rst index 6f1f7d5..e7d9b27 100644 --- a/Doc/sphinx/gettingstarted.rst +++ b/Doc/sphinx/gettingstarted.rst @@ -1,3 +1,4 @@ +.. _gettingstarted: Getting Started with Simba ========================== @@ -18,10 +19,12 @@ minutes. Simba installer ~~~~~~~~~~~~~~~ -Everyone can download Simba at http://wizzup.org/simba/ -Go to download and download the Simba installer. +Everyone can get Simba at http://wizzup.org/simba/ -Once it is done downloading, simply run the installer and follow the steps. +Go to *Download* and download the Simba installer. + +Once it is done downloading, simply run the installer, follow the steps and +please make notice of the following note: .. note:: Simba will install to C:/ by default; if you want to install it @@ -35,18 +38,20 @@ Once it is done downloading, simply run the installer and follow the steps. Simba will probably tell you there is an update available. In this case, an update button will appear. Click it and the Simba Updater will show up. -Alternatively you can update Simba using Tools -> Update. +Alternatively you can update Simba using Tools -> Update which will update Simba +if there is a new update available. .. note:: - Updating Simba regularly is recommended. + Updating Simba as soon as an update is released is recommended. -Downloading Simba binary -~~~~~~~~~~~~~~~~~~~~~~~~ +Portable Simba Installation +~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This is harder and not recommended. Steps on how to do this will follow later. +.. + TODO -For now, simply stick to the installer and update Simba after the install has -completed. +To get a portable installation at this time is not supported but will follow +sooner or later. Setting up SRL 4 with Simba --------------------------- @@ -54,7 +59,7 @@ Setting up SRL 4 with Simba If you were using the :ref:`simba-installer` then you can simply enable the ``SRL Updater`` extension. (Go to View -> Extensions and enable ``srl.sex``) -See :ref:`simbaext` for more information on Extensions. +See :ref:`simbaext` for more information on (other) Simba extensions. This is the only supported way. You can simply do a svn checkout on the srl repository, but if you can do that, then you should be able to set up SRL @@ -68,6 +73,9 @@ This will follow later, upon SRL 5 release. Installing scripts ------------------ +.. + TODO + Scripts can be downloaded with the Script Manager, in Tools -> Script Manager. .. note:: diff --git a/Doc/sphinx/index.rst b/Doc/sphinx/index.rst index aec03f4..2dd9792 100644 --- a/Doc/sphinx/index.rst +++ b/Doc/sphinx/index.rst @@ -7,11 +7,28 @@ Welcome to the Simba documentation! =================================== .. note:: - The documentation is still WIP (Work In Progress) -Welcome to the Documentation for the Simba project. -This documentation is aimed at providing documentation on just about anything -you'd want to know about Simba. + Welcome to the Documentation for the Simba project. + The documentation is actively being worked on and somewhat incomplete. + +This documentation aims to provide information on just about anything +there is to know about Simba. + +Starting points are :ref:`whatis`, :ref:`gettingstarted` and the :ref:`scriptref` + +Want to help out with the documentation? See :ref:`docdoc`. + + +Simba is a program used to repeat certain (complicated) tasks. Typically these +tasks involve using the mouse and keyboard. Simba is programmable, which means +you can design your own logic and steps that Simba will follow, based upon +certain input or as a reaction to a certain action. + +Simba is created by the SRL community, fully open source and actively +maintained. + +For community forums see http://villavu.com/ + Contents: @@ -19,7 +36,6 @@ Contents: :maxdepth: 2 whatis.rst - whatsnew.rst whysimba.rst gettingstarted.rst troubleshooting.rst @@ -31,6 +47,7 @@ Contents: referencesimba.rst docdoc.rst todo.rst + libmml.rst pymml.rst diff --git a/Doc/sphinx/libmml.rst b/Doc/sphinx/libmml.rst new file mode 100644 index 0000000..607a244 --- /dev/null +++ b/Doc/sphinx/libmml.rst @@ -0,0 +1,11 @@ + +.. _lib-mml: + +libMML +========== + +.. toctree:: + :maxdepth: 2 + + libmml/intro.rst + diff --git a/Doc/sphinx/libmml/intro.rst b/Doc/sphinx/libmml/intro.rst new file mode 100644 index 0000000..2828323 --- /dev/null +++ b/Doc/sphinx/libmml/intro.rst @@ -0,0 +1,103 @@ +libMML +====== + +libMML is short for the library to the Mufasa Macro Library. + + +Why libMML? +----------- + +One of the first questions that rise are probably *why* libMML and *what* is +libMML exactly? + +libMML is a loadable C-like library that provides most of the MML functionality. +For the ones that do not know, MML is the core component for Simba that does all +the *computational* and *algorithmic* work. See :ref:`mmlref` for more +information. + +To summarize, the MML covers: + + - Targetting specific windows and getting the window information such as + their bitmaps and dimensions. + - Controlling the mouse and keyboard. + - Finding colours, bitmaps and dtms. + - Text recognition (OCR) + - Accessing files and sockets in an unified manner + +Hopefully the *what* part of the question has mainly been covered by now. If +you're literate in computer science the *why* question has also been answered as +soon as it was mentioned that is was a loadable library - which is also implied +by its name. Exporting the MML into a loadable library allows virtually any +program to load it and just use all the MML functionality. + +Design (issues) +--------------- + +libMML itself should not be too complex. It should simply translate the OOP MML +to a non-OOP C-type library and convert datatypes when required (see below as to +why). libMML is basically just a codebase that calls MML functions and passes +the result along in a slightly different format. In simple cases such as +MoveMouse the integers are simply passed; since there's do not differ, but in +the case of arrays of any type we have to copy the arrays to a C format - at +least until MML internally will no longer use Free Pascal (managed) arrays. + +As previously mentioned, libMML is a *C*-type library; this is mentioned +explicitly because MML is written in Free Pascal (Object Pascal) which has quite +a few different datatypes. Strings are typically not compatible, and arrays are +managed in Pascal whereas they are not in C which makes it hard to just *pass* +the array along. One of the problems we have to cope with when writing libMML is +converting datatypes to C-compatible datatypes. C-compatible datatypes are +supported by most programming languages and thus the best way to go when making +a universal MML library. + +libMML use cases +---------------- + +Theoretically libMML can be loaded by any programming language; but typically +each programming languages has it's own kind of programming practices and thus +write - again - their own wrapper around libMML. This is what is being done with +*pyMML*, the python libMML wrapper. It is still as much in development as libMML +is, but the functionality exposed by libMML is succesfully used. + +<<<<<<< HEAD +======= +As of writing the pyMML usage looks like this, the passing around of a client +may be removed in a later stage, or at least have it's behaviour changed. + +.. code-block:: python + + DLL = MMLCore('../libmml.so') + + client = DLL.dll.create_client() + print 'Python Client: %d' % client + if client in (0, 1): + raise Exception('Could create a client'); + + c = Color(DLL, client) + + + ret = c.find((0, 0, 100, 100), 0) + print ret + + ret = c.find_all((0, 0, 100, 100), 0, tol=100) + print ret + + m = Mouse(DLL, client) + + print m[(Mouse.Pos, Mouse.Left, Mouse.Right)] + m[(Mouse.Pos, Mouse.Right)] = ((300,300), True) + + print m.getButtonStates() + sleep(0.5) + m.setPos((200,200)) + + sleep(2) + print 'Done' + + m[(Mouse.Left, Mouse.Right, Mouse.Middle)] = [False for x in range(3)] + for v in zip((Mouse.Left, Mouse.Right), m[(Mouse.Left, Mouse.Right)]): + print v + print m.getPos() + + del DLL +>>>>>>> master diff --git a/Doc/sphinx/pymml.rst b/Doc/sphinx/pymml.rst index 664ee22..63838f9 100644 --- a/Doc/sphinx/pymml.rst +++ b/Doc/sphinx/pymml.rst @@ -6,7 +6,6 @@ Python MML .. toctree:: :maxdepth: 2 - pymml/mml.rst pymml/mouse.rst pymml/color.rst diff --git a/Doc/sphinx/referencemml.rst b/Doc/sphinx/referencemml.rst index 4598022..7510d29 100644 --- a/Doc/sphinx/referencemml.rst +++ b/Doc/sphinx/referencemml.rst @@ -1,3 +1,5 @@ +.. _mmlref: + MML Reference ============= @@ -10,7 +12,7 @@ There currently is an effort to create a standalone library of the MML; called *libMML*. This way any application can just load the library and use the MML functionality. -The MML is split up in "Core" classes and "Addon" classes. +The MML is split up in "Core" classes and "Addon" classes. .. note:: This section needs to explain more on the core/addon differences, diff --git a/Doc/sphinx/referencescript.rst b/Doc/sphinx/referencescript.rst index 28e2097..33c4848 100644 --- a/Doc/sphinx/referencescript.rst +++ b/Doc/sphinx/referencescript.rst @@ -1,3 +1,5 @@ +.. _scriptref: + Scripting Reference =================== diff --git a/Doc/sphinx/scriptref/bitmaps.rst b/Doc/sphinx/scriptref/bitmaps.rst index edd156f..cedf21c 100644 --- a/Doc/sphinx/scriptref/bitmaps.rst +++ b/Doc/sphinx/scriptref/bitmaps.rst @@ -4,12 +4,44 @@ Bitmaps ======= +A bitmap in Simba is simply a two dimensional *field of colours*. These colours +can all be the same, or they can be of different colours. Simba features +functions to create, manipulate and search for bitmaps. + +.. INSERT BITMAP EXAMPLE HERE (Picture, etc) + +The bitmaps are - just as files - represented as integer in Simba (they point to +a list of bitmaps, and the value of the integer is the position in the list). +So typically, when referring to bitmaps in Simba, you simply represent them as +an integer: + +.. code-block:: pascal + + var bmp, x, y: integer; + bmp := CreateBitmap(10, 10); // Create a bitmap of size (10, 10) + if FindBitmapIn(bmp, x, y, 0, 0, 300, 300) then + writeln('Found it!'); + FreeBitmap(bmp); // Don't forget to free it when we are done. + +Note that the previous example doesn't make a lot of sense as the bitmap has +only been created and not filled with any colours, they are as of yet, +undefined. You can also create bitmaps from screenshots and load them when your +script starts using the :ref:`scriptref-bitmapfromstring` function, or +simple store them as files and load them using the :ref:`scriptref-loadbitmap` +function. + +Word of caution on bitmap creation +---------------------------------- + Bitmaps in Simba are internally all instances of *TMufasBitmap*. Scripts should generally access bitmaps using their *handle*: an integer. All functions referenced here either require a bitmap *handle* or return one. If you want to gain more access over a specific bitmap, see the -*GetMufasaBitmap* function. It is highly unrecommended to create bitmaps with: +*GetMufasaBitmap* function. It is highly unrecommended to create bitmaps like +this, because Simba will not free them automatically for you. (There's no +problem doing it like this if you only want to perform operations on it and then +free it again) .. code-block:: pascal @@ -48,6 +80,7 @@ then call this function to get the class reference. bmp.SetSize(150,150); // also changes bmph, as they are the same bitmap. +.. _scriptref-createbitmapstring: CreateBitmapString ------------------ @@ -56,7 +89,11 @@ CreateBitmapString function CreateBitmapString(bmp : integer) : string; -Creates a string for the given bitmap. +Creates a string for the given bitmap, you can use this to save a bitmap for +later us, for example loading it again using :ref:`scriptref-bitmapfromstring`. + + +.. _scriptref-createbitmap: CreateBitmap ------------ @@ -65,8 +102,10 @@ CreateBitmap function CreateBitmap(w,h :integer) : integer; -Create a bitmap with width *h* and height *h*. Returns the bitmap reference. +Create a bitmap with width *h* and height *h*. +Returns the reference to the created bitmap. +.. _scriptref-freebitmap: FreeBitmap ---------- @@ -80,6 +119,8 @@ Be careful when working with bitmaps: not freeing it when you no longer need it leads to memory leaks, which will eventually make your script crash. (Unless you stop it in time, in which case Simba will free the bitmaps for you) +.. _scriptref-savebitmap: + SaveBitmap ---------- @@ -89,6 +130,8 @@ SaveBitmap Save the given bitmap to the specified path. +.. _scriptref-bitmapfromstring: + BitmapFromString ---------------- @@ -99,6 +142,7 @@ BitmapFromString Load a bitmap from the given string. This command is usually generated with the Bitmap to String feature in Simba. +.. _scriptref-loadbitmap: LoadBitmap ---------- @@ -107,8 +151,10 @@ LoadBitmap function LoadBitmap(Path : string) : integer; -Load a bitmap from a path to a file. Known formats are .bmp and .png. (Possibly -others, don't know for sure) +Load a bitmap from a path to a file. Formats known to work are BMP and PNG +images. + +.. _scriptref-setbitmapsize: SetBitmapSize ------------- @@ -117,7 +163,12 @@ SetBitmapSize procedure SetBitmapSize(Bmp,NewW,NewH : integer); -Change the size of the bitmap. Previous data will be preserved (if possible). +Change the size of the bitmap. +Previous data will be preserved (if possible), so enlarging the bitmap won't +destroy the old data, but shrinking it will inevitably destroy some data. +(Everything that falls out of the new bounds) + +.. _scriptref-getbitmapsize: GetBitmapSize ------------- @@ -128,6 +179,8 @@ GetBitmapSize Returns the size of the bitmap in *BmpW*, *BmpH*. +.. _scriptref-stretchbitmapresize: + StretchBitmapResize ------------------- @@ -136,6 +189,8 @@ StretchBitmapResize procedure StretchBitmapResize(Bmp,NewW,NewH : integer); +.. _scriptref-createmirroredbitmap: + CreateMirroredBitmap -------------------- @@ -144,6 +199,8 @@ CreateMirroredBitmap function CreateMirroredBitmap(Bmp : integer) : integer; +.. _scriptref-createmirroredbitmapex: + CreateMirroredBitmapEx ---------------------- @@ -152,6 +209,8 @@ CreateMirroredBitmapEx function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer; +.. _scriptref-fastsetpixel: + FastSetPixel ------------ @@ -161,6 +220,8 @@ FastSetPixel Set the pixel on the bitmap at position x, y to *color*. +.. _scriptref-fastsetpixels: + FastSetPixels ------------- @@ -170,6 +231,7 @@ FastSetPixels Set the pixels on the bitmap at position TPA[index] to Colors[index]. +.. _scriptref-fastgetpixel: FastGetPixel ------------ @@ -180,6 +242,8 @@ FastGetPixel Return the colour of pixel on the bitmap, position specified by x, y. +.. _scriptref-fastgetpixels: + FastGetPixels ------------- @@ -189,6 +253,7 @@ FastGetPixels Return an array of the colours on the bitmap; positions specified by *TPA*. +.. _scriptref-getbitmapareacolors: GetBitmapAreaColors ------------------- @@ -200,6 +265,8 @@ GetBitmapAreaColors Returns all the colours in the area defined by (*xs*, *xy*, *xe*, *ye*) on the bitmap in a two dimensions integer array. +.. _scriptref-fastdrawclear: + FastDrawClear ------------- @@ -209,6 +276,8 @@ FastDrawClear Draw *Color* on every pixel on the bitmap. +.. _scriptref-fastdrawtransparent: + FastDrawTransparent ------------------- @@ -217,6 +286,8 @@ FastDrawTransparent procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer); +.. _scriptref-setransparentcolor: + SetTransparentColor ------------------- @@ -224,6 +295,7 @@ SetTransparentColor procedure SetTransparentColor(bmp : integer; Color : TColor); +.. _scriptref-getransparentcolor: GetTransparentColor ------------------- @@ -232,6 +304,7 @@ GetTransparentColor function GetTransparentColor(bmp: integer) : TColor; +.. _scriptref-fastreplacecolor: FastReplaceColor ---------------- @@ -240,6 +313,7 @@ FastReplaceColor procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor); +.. _scriptref-copyclienttobitmap: CopyClientToBitmap ------------------ @@ -250,6 +324,8 @@ CopyClientToBitmap Copy client area *xs, ys, xe, ye* to specified bitmap. +.. _scriptref-bitmapfromclient: + BitmapFromClient ---------------- @@ -259,6 +335,8 @@ BitmapFromClient Create a bitmap from the client. Area specified by *xs, ye, xe, ye*. +.. _scriptref-setbitmapname: + SetBitmapName ------------- @@ -269,6 +347,20 @@ SetBitmapName Assign a name to the bitmap. Mainly for debugging purposes. (It will write the name of the bitmap if it hasn't been freed.) +.. code-block:: pascal + + program new; + + var bmp: integer; + begin + bmp := CreateBitmap(10, 10); + SetBitmapName(bmp, 'We will not free this bitmap'); + end. + // Simba will print what bitmap has not been freed (along with his long + // name) + +.. _scriptref-findbitmap: + FindBitmap ---------- @@ -279,6 +371,8 @@ FindBitmap Searches for the Bitmap *bmp* on the entire client. Returns true if found. If found, *x, y* specifies the position where the bitmap was found. +.. _scriptref-findbitmapin: + FindBitmapIn ------------ @@ -291,6 +385,8 @@ Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye* Returns true if found. If found, *x, y* specifies the position where the bitmap was found. +.. _scriptref-findbitmaptolerancein: + FindBitmapToleranceIn --------------------- @@ -300,10 +396,12 @@ FindBitmapToleranceIn Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*. Tolerance defines the tolerance per pixel when matching bitmaps. See -:ref:`scriptref_CTS` for more information on tolerance. +:ref:`scriptref-CTS` for more information on tolerance. Returns true if found. If found, *x, y* specifies the position where the bitmap was found. +.. _scriptref-findbitmapspiral: + FindBitmapSpiral ---------------- @@ -316,6 +414,8 @@ Returns true if found. If found, *x, y* specifies the position where the bitmap was found. Search starts from a point defined by *x, y*. +.. _scriptref-findbitmapsspiraltolerance: + FindBitmapsSpiralTolerance -------------------------- @@ -326,10 +426,12 @@ FindBitmapsSpiralTolerance Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*. Tolerance defines the tolerance per pixel when matching bitmaps. See -:ref:`scriptref_CTS` for more information on tolerance. +:ref:`scriptref-CTS` for more information on tolerance. Search starts from a point defined by *x, y*. Returns true if found. If found, each point in *TPA* specifies a match. +.. _scriptref-findbitmapspiraltolerance: + FindBitmapSpiralTolerance ------------------------- @@ -339,11 +441,13 @@ FindBitmapSpiralTolerance Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*. Tolerance defines the tolerance per pixel when matching bitmaps. See -:ref:`scriptref_CTS` for more information on tolerance. +:ref:`scriptref-CTS` for more information on tolerance. Search starts from a point defined by *x, y*. Returns true if found. If found, *x, y* specifies the position where the bitmap was found. +.. _scriptref-rotatebitmap: + RotateBitmap ------------ @@ -352,6 +456,8 @@ RotateBitmap function RotateBitmap(bitmap: Integer; angle: Extended): Integer; +.. _scriptref-desaturatebitmap: + DesaturateBitmap ---------------- @@ -360,6 +466,8 @@ DesaturateBitmap function DesaturateBitmap(Bitmap : integer) : integer; +.. _scriptref-invertbitmap: + InvertBitmap ------------ @@ -368,6 +476,8 @@ InvertBitmap procedure InvertBitmap(Bitmap : integer); +.. _scriptref-copybitmap: + CopyBitmap ---------- @@ -377,6 +487,8 @@ CopyBitmap Creates a copy of the *Bitmap*. Returns the bitmap copy. +.. _scriptref-greyscalebitmap: + GreyScaleBitmap --------------- @@ -386,6 +498,7 @@ GreyScaleBitmap Creates a copy of the bitmap, greyscaled. +.. _scriptref-brightnessbitmap: BrightnessBitmap ---------------- @@ -400,6 +513,8 @@ Returns a new bitmap with the brightness applied. If you instead want to apply brightness to the current bitmap, see :ref:`filter_apply_bitmap` +.. _scriptref-contrastbitmap: + ContrastBitmap -------------- @@ -410,6 +525,7 @@ ContrastBitmap Changes the constrast of a bitmap, returns a new bitmap with the contrast applied. +.. _scriptref-posterizebitmap: PosterizeBitmap --------------- @@ -441,6 +557,8 @@ Applying a filter on the current bitmap FreeBitmap(b); end. +.. _scriptref-createmaskfrombitmap: + CreateMaskFromBitmap -------------------- @@ -449,6 +567,8 @@ CreateMaskFromBitmap function CreateMaskFromBitmap(Bitmap : integer) : TMask; +.. _scriptref-findmasktolerance: + FindMaskTolerance ----------------- @@ -457,6 +577,8 @@ FindMaskTolerance function FindMaskTolerance(const mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; +.. _scriptref-findbitmapmasktolerance: + FindBitmapMaskTolerance ----------------------- @@ -465,6 +587,8 @@ FindBitmapMaskTolerance function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; +.. _scriptref-finddeformedbitmaptolerancein: + FindDeformedBitmapToleranceIn ----------------------------- @@ -473,6 +597,8 @@ FindDeformedBitmapToleranceIn function FindDeformedBitmapToleranceIn(bitmap: integer; var x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean; +.. _scriptref-drawtpabitmap: + DrawTPABitmap ------------- @@ -484,6 +610,7 @@ DrawTPABitmap on the bitmap by setting the pixel on the bitmap (position defined by tpa point) to *color*. +.. _scriptref-drawatpabitmap: DrawATPABitmap -------------- @@ -497,6 +624,8 @@ Each point in the TPointArray is *painted* on the bitmap by setting the pixel on the bitmap (position defined by tpa point) to a color. Colors differ per TPointArray (group). +.. _scriptref-drawatpabitmapex: + DrawATPABitmapEx ---------------- @@ -509,6 +638,7 @@ Each point in the TPointArray is *painted* on the bitmap by setting the pixel on the bitmap (position defined by tpa point) to a color. Colors are defined by *Colors*. +.. _scriptref-drawbitmap: DrawBitmap ---------- @@ -519,6 +649,8 @@ DrawBitmap Draw the bitmap to a TCanvas. +.. _scriptref-rectanglebitmap: + RectangleBitmap --------------- @@ -527,6 +659,8 @@ RectangleBitmap procedure RectangleBitmap(bitmap : integer; const box : TBox; Color : TColor); +.. _scriptref-floodfillbitmap: + FloodFillBitmap --------------- @@ -535,6 +669,8 @@ FloodFillBitmap procedure FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor); +.. _scriptref-calculatepixelshift: + CalculatePixelShift ------------------- @@ -543,6 +679,8 @@ CalculatePixelShift function CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer; +.. _scriptref-calculatepixeltolerance: + CalculatePixelTolerance ----------------------- @@ -550,4 +688,3 @@ CalculatePixelTolerance function CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;') - diff --git a/Doc/sphinx/scriptref/colourconverting.rst b/Doc/sphinx/scriptref/colourconverting.rst index c5ca97d..6299f0a 100644 --- a/Doc/sphinx/scriptref/colourconverting.rst +++ b/Doc/sphinx/scriptref/colourconverting.rst @@ -1,8 +1,11 @@ -.. _scriptref_colourconv: +.. _scriptref-colourconv: Colour Conversions ================== +.. + TODO: + Colour spaces ------------- @@ -12,6 +15,7 @@ Explain some colour spaces here. Colour Conversion Methods ------------------------- +.. _scriptref-colortorgb: ColorToRGB ~~~~~~~~~~ @@ -20,6 +24,8 @@ ColorToRGB procedure ColorToRGB(Color: integer; var r, g, b: Integer); +.. _scriptref-rgbtocolor: + RGBtoColor ~~~~~~~~~~ @@ -27,6 +33,8 @@ RGBtoColor function RGBtoColor(r, g, b: Integer): TColor; +.. _scriptref-colortohsl: + ColorToHSL ~~~~~~~~~~ @@ -34,6 +42,8 @@ ColorToHSL procedure ColorToHSL(Color: Integer; var h, s, l: Extended); +.. _scriptref-hsltocolor: + HSLToColor ~~~~~~~~~~ @@ -41,6 +51,8 @@ HSLToColor function HSLToColor(H, S, L: Extended): TColor; +.. _scriptref-colortoxyz: + ColorToXYZ ~~~~~~~~~~ @@ -48,6 +60,8 @@ ColorToXYZ procedure ColorToXYZ(Color: Integer; var x, y, z: Extended); +.. _scriptref-xyztocolor: + XYZToColor ~~~~~~~~~~ @@ -55,6 +69,8 @@ XYZToColor function XYZToColor(X, Y, Z: Extended): TColor; +.. _scriptref-rgbtohsl: + RGBToHSL ~~~~~~~~ @@ -62,6 +78,8 @@ RGBToHSL procedure RGBToHSL(R, G, B: Integer; var h, s, l: Extended); +.. _scriptref-hsltorgb: + HSLtoRGB ~~~~~~~~ @@ -69,6 +87,8 @@ HSLtoRGB procedure HSLtoRGB(H, S, L: extended; var R, G ,B: Integer); +.. _scriptref-rgbtoxyz: + RGBToXYZ ~~~~~~~~ @@ -76,6 +96,8 @@ RGBToXYZ procedure RGBToXYZ(R, G, B: Integer;var x, y ,z: Extended); +.. _scriptref-xyztorgb: + XYZToRGB ~~~~~~~~ @@ -83,4 +105,5 @@ XYZToRGB procedure XYZToRGB(X, Y, Z: Extended; var R, G, B: Integer); - +.. + TODO: Add CIE L*a*b. diff --git a/Doc/sphinx/scriptref/colourfinding.rst b/Doc/sphinx/scriptref/colourfinding.rst index aa4fb5b..714ff37 100644 --- a/Doc/sphinx/scriptref/colourfinding.rst +++ b/Doc/sphinx/scriptref/colourfinding.rst @@ -37,6 +37,7 @@ components: a *TPointArray*. .. note:: + Other techniques exist, which involve relative point distance from one point to another; these are found in the :ref:`scriptref-dtm` section. @@ -51,6 +52,8 @@ Colour Finding Methods A list of all colour finding methods in Simba. +.. _scriptref-similarcolors: + SimilarColors ~~~~~~~~~~~~~ @@ -61,6 +64,8 @@ SimilarColors SimilarColors returns true if the two passed colours are *similar* given the passed *Tolerance*. +.. _scriptref-getcolor: + GetColor ~~~~~~~~ @@ -68,13 +73,19 @@ GetColor function GetColor(x, y: Integer): Integer; -GetColor returns the color on the coordinate (*x*, *y*). +GetColor returns the color on the coordinate *(x, y)*. -*Example: Printing the colour on coordinate (25, 25)* +Example printing the colour on coordinate (25, 25). .. code-block:: pascal - Writeln('Colour is ' + IntToStr(GetColor(25, 25))) + program printcolour; + + begin + Writeln('Colour is ' + IntToStr(GetColor(25, 25))) + end. + +.. _scriptref-getcolors: GetColors ~~~~~~~~~ @@ -85,6 +96,7 @@ GetColors GetColors returns an array of the colours at the given *Coords*. +.. _scriptref-countcolor: CountColor ~~~~~~~~~~ @@ -96,6 +108,8 @@ CountColor Returns how many times *Color* occurs in the area defined by (*xs*, *ys*), (*xe*, *ye*) +.. _scriptref-countcolortolerance: + CountColorTolerance ~~~~~~~~~~~~~~~~~~~ @@ -106,6 +120,8 @@ CountColorTolerance Returns how many times *Color* occurs (within *Tolerance*) in the area defined by (*xs*, *ys*), (*xe*, *ye*) +.. _scriptref-findcolor: + FindColor ~~~~~~~~~ @@ -121,6 +137,8 @@ The point is returned in *x* and *y*. It searches from the top left to the bottom right and will stop after matching a point. +.. _scriptref-findcolortolerance: + FindColorTolerance ~~~~~~~~~~~~~~~~~~ @@ -134,9 +152,11 @@ FindColorTolerance returns true if a colour within the given tolerance range *x2*, *y2*. Only the first point is returned in *x* and *y*. Whether or not a colour is within the tolerance range is determined by the -:ref:`scriptref_CTS` mode. It searches from the top left to the bottom right +:ref:`scriptref-CTS` mode. It searches from the top left to the bottom right and will stop after matching a point. +.. _scriptref-findcolors: + FindColors ~~~~~~~~~~ @@ -148,6 +168,8 @@ FindColors returns a list of all points that match the colour *col* in an area defined by *x1*, *y1*, *x2*, *y2*. It returns true if one or more points have been found. +.. _scriptref-findcolorstolerance: + FindColorsTolerance ~~~~~~~~~~~~~~~~~~~ @@ -160,10 +182,12 @@ FindColorsTolerance returns true if at least one point was found. A point is found if it is within the given tolerance range *tol* of the given colour *col* and inside the box defined by *x1*, *y1*, *x2*, *y2*. Whether or not a color is within the tolerance range is determined by the -:ref:`scriptref_CTS` mode. +:ref:`scriptref-CTS` mode. It searches from the top left to the bottom right and will find all matching points in the area. +.. _scriptref-findcolorspiral: + FindColorSpiral ~~~~~~~~~~~~~~~ @@ -174,6 +198,8 @@ FindColorSpiral Same as FindColor, but starts searching from *x*, *y*. +.. _scriptref-findcolorspiraltolerance: + FindColorSpiralTolerance ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -184,6 +210,8 @@ FindColorSpiralTolerance Same as FindColorTolerance, but starts searching from *x*, *y*. +.. _scriptref-findcolorsspiraltolerance: + FindColorsSpiralTolerance ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -194,6 +222,9 @@ FindColorsSpiralTolerance Same as FindColorsTolerance, but starts searching from *x*, *y*. +.. _scriptref-findcoloredarea: +.. _scriptref-findcoloredareatolerance: + Find areas of colours ~~~~~~~~~~~~~~~~~~~~~ @@ -215,7 +246,7 @@ FindColoredArea finds an area that consists out of Colours that match *Color* wi the given *Tolerance* and has a minimal size of *MinArea*. If you want minimal area of 5x5 pixels (25), then set MinArea to 25. -.. _scriptref_CTS: +.. _scriptref-CTS: Colour tolerance ---------------- @@ -236,6 +267,11 @@ given a tolerance. There are three algorithms, from fastest to slowest: very little in hue. Luminance is assigned a somewhat static function, and has no modifier. +.. + TODO: CIE-Lab + +.. _scriptref-gettolerancespeed: +.. _scriptref-setcolortolerancespeed: Get and Set Colour Tolerance ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -258,12 +294,15 @@ function, which returns the current colour tolerance speed: function GetToleranceSpeed: Integer; -*Example: Printing the Color Tolerance* +Example printing the Color Tolerance .. code-block:: pascal Writeln(Format('Tolerance Speed = %d', [GetToleranceSpeed])) +.. _scriptref-settolerancespeed2modifiers: +.. _scriptref-gettolerancespeed2modifiers: + Get And Set Colour Modifiers ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -280,14 +319,14 @@ Set colour speed 2 modifiers. SetToleranceSpeed2Modifiers(42.0, 0.4) The following function - + .. code-block:: pascal procedure GetToleranceSpeed2Modifiers(var hMod, sMod: Extended); returns colour speed 2 modifiers. -*Example: Getting the modifiers* +Example getting the modifiers: .. code-block:: pascal diff --git a/Doc/sphinx/scriptref/mouseandkeyboard.rst b/Doc/sphinx/scriptref/mouseandkeyboard.rst index 77aba68..55a7d73 100644 --- a/Doc/sphinx/scriptref/mouseandkeyboard.rst +++ b/Doc/sphinx/scriptref/mouseandkeyboard.rst @@ -1,6 +1,9 @@ Mouse and Keyboard ================== +Simba contains several functions to manipulate the mouse and keyboard. +Features range from clicking and moving the mouse to faking keypresses. + Types ----- @@ -27,15 +30,43 @@ list. Mouse Functions --------------- +Simba's coordinate system is similar to most computer coordinate systems. +Coordinate *(0, 0)* is the top-left part of your selected window (the desktop by +default). To get to point *(5, 0)* we move five pixels to the right; to get to +*(5, 5)* we move five pixels to the right, and five pixels down. + +Recall that the first value is *x*, the second value is *y*: *(x, y)* + +.. + TODO: Picture? + MoveMouse ~~~~~~~~~ +.. _scriptref-movemouse: + .. code-block:: pascal - + procedure MoveMouse(x, y: integer); MoveMouse moves the mouse pointer to the specified x and y coordinates. +The following example will move the mouse to position *(10, 10)*; relative +to the selected client. (To get to point (10, 10) visually, recall that (0, 0) +is the *top left* part and to get to (10, 10) we move 10 pixels to the right, +and ten pixels down.) + +.. code-block:: pascal + + Program MouseMove; + + begin + MoveMouse(10, 10); + end. + + +.. _scriptref-getmousepos: + GetMousePos ~~~~~~~~~~~ @@ -43,9 +74,23 @@ GetMousePos procedure GetMousePos(var x, y: integer); -GetMousePos returns the current position of the mouse in x and -y. +GetMousePos returns the current position of the mouse in x and y. +The following example moves the mouse 1 pixel to the right, relative to its +current position: + +.. code-block:: pascal + + Program MouseMoveRelative; + + var x, y: integer; + + begin + GetMousePos(x, y); + MoveMouse(x + 1, y); + end. + +.. _scriptref-holdmouse: HoldMouse ~~~~~~~~~ @@ -54,9 +99,14 @@ HoldMouse procedure HoldMouse(x, y: Integer; clickType: TClickType); -HoldMouse holds the given mouse button (clickType) down at the specified -x, y coordinate. If the mouse if not at the given x, y yet, the mouse position -will be set to x, y. +HoldMouse holds the given mouse button specified by clickType down at the +specified *(x, y)* coordinate. If the mouse if not at the given +(*x, y)* yet, the mouse position will be set to *(x, y)*. + +.. + TODO: Example + +.. _scriptref-releasemouse: ReleaseMouse ~~~~~~~~~~~~ @@ -69,6 +119,11 @@ HoldMouse holds the given mouse button (clickType) down at the specified x, y coordinate. If the mouse if not at the given x, y yet, the mouse position will be set to x, y. +.. + TODO: Example + +.. _scriptref-clickmouse: + ClickMouse ~~~~~~~~~~ @@ -77,7 +132,9 @@ ClickMouse procedure ClickMouse(x, y: Integer; clickType: Integer): ClickMouse performs a click with the given mouse button (clickType) at the -specified x, y coordinate. +specified *(x, y)* coordinate. This ``click`` equals an immediate click, with no +wait between holding down and releasing the mouse button. To create a more +human-like effect, use the HoldMouse and ReleaseMouse functions. Keyboard Functions ------------------ @@ -85,18 +142,22 @@ Keyboard Functions Keyboard functions are obviously used to manipulate the keyboard input. It can also be used to read states of specific keys. +.. _scriptref-keydown: KeyDown ~~~~~~~ - .. code-block:: pascal procedure KeyDown(key: Word); KeyDown sends a request to the Operating System to "fake" an event that -causes the ``key`` to be "down". +causes the keyboard ``key`` to be "down". +.. + TODO: Example + +.. _scriptref-keyup: KeyUp ~~~~~ @@ -108,8 +169,10 @@ KeyUp KeyDown sends a request to the Operating System to "fake" an event that causes the ``key`` to be "up". +.. + TODO: Example -.. _virtualkeys: +.. _scriptref-virtualkeys: Keyboard Virtual Keys --------------------- diff --git a/Doc/sphinx/scriptref/sound.rst b/Doc/sphinx/scriptref/sound.rst index fd06ac3..e77a8ae 100644 --- a/Doc/sphinx/scriptref/sound.rst +++ b/Doc/sphinx/scriptref/sound.rst @@ -1,12 +1,12 @@ -.. _scriptref_web: +.. _scriptref_sound: Multimedia Functions ==================== Sound Functions --------------- +--------------- PlaySound ~~~~~~~~~ diff --git a/Doc/sphinx/todo.rst b/Doc/sphinx/todo.rst index 4f0b792..bd86058 100644 --- a/Doc/sphinx/todo.rst +++ b/Doc/sphinx/todo.rst @@ -3,7 +3,6 @@ Documentation TODO ================== -* **WIP** - What's New. Changelog template added, fill it with stuff. * *Wizzup* - Script manager (non technical). * *Wizzup* - Script manager (technical). * Extend "Getting Started". Include downloading scripts from the manager. diff --git a/Doc/sphinx/troubleshooting.rst b/Doc/sphinx/troubleshooting.rst index e2dc2e3..c85620f 100644 --- a/Doc/sphinx/troubleshooting.rst +++ b/Doc/sphinx/troubleshooting.rst @@ -23,9 +23,10 @@ Simba crashes on start complaining about settings.xml This means your settings.xml has become corrupt somehow, or Simba may not be able to create it. If a settings.xml exists in your Simba directory, you can -delete it. (All your settings will be lost, but this shouldn't be a bug deal) +delete it. (All your settings will be lost, but this shouldn't be a big deal) Note that this should no longer happen with Simba 750 and up. -.. +.. + TODO Anything else? diff --git a/Doc/sphinx/whatis.rst b/Doc/sphinx/whatis.rst index 6f16bcc..e9e8479 100644 --- a/Doc/sphinx/whatis.rst +++ b/Doc/sphinx/whatis.rst @@ -1,3 +1,5 @@ +.. _whatis: + What Is Simba? ============== @@ -22,4 +24,11 @@ Simba can: and more. Start now by :ref:`installingsimba`. +Currently Simba is still in its beta stages; this includes the documentation. +You will probably notice some parts of the documentation aren't finished or are just +plain missing. + +Simba is being updated almost every day. To see changes as they are added, view +https://github.com/MerlijnWajer/Simba. + If you want to know more about Simba, see :ref:`whysimba` diff --git a/Doc/sphinx/whatsnew.rst b/Doc/sphinx/whatsnew.rst deleted file mode 100644 index 57d4c6f..0000000 --- a/Doc/sphinx/whatsnew.rst +++ /dev/null @@ -1,10 +0,0 @@ -What's new in Simba? -==================== - -Currently Simba is still in its beta stages; this includes the documentation. -You will probably notice some parts of the documentation aren't finished or are just -plain missing. - -Simba is being updated almost every day. To see changes as they are added, view -https://github.com/MerlijnWajer/Simba. Each commit should be explained -in one line, and the exact changes can be viewed with "commitdiff". diff --git a/Doc/sphinx/whysimba.rst b/Doc/sphinx/whysimba.rst index 3b2713d..26b19ef 100644 --- a/Doc/sphinx/whysimba.rst +++ b/Doc/sphinx/whysimba.rst @@ -11,15 +11,15 @@ the open-mindedness of the Simba developers. Free ~~~~ -Simba is, and always will be free. +Simba is, and always will be free. It is free as in Free Beer **and** Freedom. -Simba is 100% free to use. In fact, we welcome you to share it with the +Simba is 100% free to use. In fact, we welcome you to share it with the rest of the world. -The source code to the program is freely available, under the GPL (v3) license. +The source code to the program is freely available, under the GPL (v3) license. -.. note:: +.. note:: The source code allows everyone to see how the program actually works. Most developers choose not to share their source code and therefore decide to withhold knowledge. The Simba developers highly disagree with @@ -39,19 +39,19 @@ This way one can easily extend Simba. See :ref:`writing-simba-extensions` Reliable ~~~~~~~~ -Simba is actively maintained by a team of knowledgeable programmers. +Simba is actively maintained by a team of knowledgeable programmers. -We as a team do our best to make Simba into a quality product. +We as a team do our best to make Simba into a quality product. However this does not guarantee a bug free program. (Bug free programs don't exist) Should you encounter a bug, please consider sending a bug report so we can -resolve the issue: :ref:`bugreport`. +try to resolve the issue: :ref:`bugreport`. Cross Platform ~~~~~~~~~~~~~~ -Simba has been written with freedom in mind and believes Simba +Simba has been written with freedom in mind and believes Simba should not be limited to one platform, as that limits its users to one platform as well. @@ -59,7 +59,7 @@ Currently the supported platforms are Windows and Linux with attempts being made to port it to OSX (it may run on OSX if you install X11). Even though we try hard to make Simba bug-free on all platforms, -some issues remain. The biggest issue is the interpreter that +some issues remain. The biggest issue is the interpreter that executes your program. It is an external component and does not play too well on Linux. Hopefully this will be improved upon soon. @@ -94,5 +94,4 @@ Well Documented ~~~~~~~~~~~~~~~ Simba is well documented. (You're looking the documentation right now...) -There is still a lot left to document but overall the documentation is pretty -good. +There is still a lot left to document though. diff --git a/Projects/Simba/Simba.inc b/Projects/Simba/Simba.inc index b0079f7..d8ec62b 100644 --- a/Projects/Simba/Simba.inc +++ b/Projects/Simba/Simba.inc @@ -30,7 +30,7 @@ //{$DEFINE USE_CPASCAL} // TODO //{$DEFINE USE_LAPE} // TODO -//{$DEFINE USE_EXTENSIONS} // TODO +//{$DEFINE USE_EXTENSIONS} //{$DEFINE USE_CODECOMPLETION} // TODO //{$DEFINE TERMINALWRITELN} // Only used once. Remove from SimbaUnit? diff --git a/Projects/Simba/Simba.lpr b/Projects/Simba/Simba.lpr index d2da58a..ac13155 100644 --- a/Projects/Simba/Simba.lpr +++ b/Projects/Simba/Simba.lpr @@ -37,7 +37,7 @@ uses PSDump, v_ideCodeParser, v_AutoCompleteForm, CastaliaPasLex, CastaliaPasLexTypes, CastaliaSimplePasPar, CastaliaSimplePasParTypes, dcpbase64, mPasLex, v_Constants, v_MiscFunctions, - extensionmanagergui, mmisc, bitmapconv; + mmisc, bitmapconv; {$R Simba.res} @@ -48,7 +48,7 @@ begin Application.CreateForm(TColourHistoryForm, ColourHistoryForm); Application.CreateForm(TAboutForm, AboutForm); Application.CreateForm(TDebugImgForm, DebugImgForm); - Application.CreateForm(TExtensionsForm, ExtensionsForm); +// Application.CreateForm(TExtensionsForm, ExtensionsForm); Application.CreateForm(TBitmapConvForm, BitmapConvForm); // Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); // Application.CreateForm(TSettingsForm, SettingsForm); Done in FormCreate of MainForm diff --git a/Projects/Simba/extensionmanager.pas b/Projects/Simba/extensionmanager.pas index 8727080..ad1d5eb 100644 --- a/Projects/Simba/extensionmanager.pas +++ b/Projects/Simba/extensionmanager.pas @@ -58,10 +58,15 @@ end; destructor TExtensionManager.Destroy; var - i: Integer; + I, C: Integer; begin - for i := 0 to Extensions.Count - 1 do - TExtension(Extensions.Items[i]).Free; + C := Extensions.Count - 1; + for I := 0 to C do + begin + TExtension(Extensions.Items[I]).Settings.Free; + TExtension(Extensions.Items[I]).Free; + end; + Extensions.Free; inherited Destroy; end; diff --git a/Projects/Simba/psextension.pas b/Projects/Simba/psextension.pas index 47756e9..7a7a2f3 100644 --- a/Projects/Simba/psextension.pas +++ b/Projects/Simba/psextension.pas @@ -265,7 +265,7 @@ begin begin {$I ../../Units/MMLAddon/PSInc/pscompile.inc} AddTypes('TStringArray','Array of String'); - AddConstantN('ExtPath','string').SetString(ExtPath); + AddConstantN('ExtPath', 'string').SetString({$IFDEF USE_EXTENSIONS}ExtPath{$ELSE}''{$ENDIF}); for i := 0 to high(VirtualKeys) do AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key); end; @@ -329,6 +329,7 @@ begin FreeScript; if Assigned(PSInstance) then FreeAndNil(PSInstance); + Script.Free; inherited; end; diff --git a/Projects/Simba/simbaunit.lfm b/Projects/Simba/simbaunit.lfm index 95f42de..f396c98 100644 --- a/Projects/Simba/simbaunit.lfm +++ b/Projects/Simba/simbaunit.lfm @@ -5,7 +5,7 @@ object SimbaForm: TSimbaForm Width = 660 AllowDropFiles = True Caption = 'THA FUKING Simba' - ClientHeight = 598 + ClientHeight = 603 ClientWidth = 660 KeyPreview = True Menu = MainMenu @@ -207,8 +207,8 @@ object SimbaForm: TSimbaForm end object StatusBar: TStatusBar Left = 0 - Height = 21 - Top = 577 + Height = 23 + Top = 580 Width = 660 Panels = < item @@ -230,7 +230,7 @@ object SimbaForm: TSimbaForm object PanelMemo: TPanel Left = 0 Height = 154 - Top = 423 + Top = 426 Width = 660 Align = alBottom ClientHeight = 154 @@ -253,19 +253,19 @@ object SimbaForm: TSimbaForm Cursor = crVSplit Left = 0 Height = 5 - Top = 418 + Top = 421 Width = 660 Align = alBottom ResizeAnchor = akBottom end object ScriptPanel: TPanel Left = 0 - Height = 394 + Height = 397 Top = 24 Width = 660 Align = alClient BevelOuter = bvNone - ClientHeight = 394 + ClientHeight = 397 ClientWidth = 660 DockSite = True TabOrder = 4 @@ -273,7 +273,7 @@ object SimbaForm: TSimbaForm OnDockOver = ScriptPanelDockOver object PageControl1: TPageControl Left = 155 - Height = 359 + Height = 362 Top = 0 Width = 505 Align = alClient @@ -292,7 +292,7 @@ object SimbaForm: TSimbaForm object SearchPanel: TPanel Left = 0 Height = 35 - Top = 359 + Top = 362 Width = 660 Align = alBottom BevelOuter = bvSpace @@ -387,7 +387,7 @@ object SimbaForm: TSimbaForm end object LabeledEditSearch: TLabeledEdit Left = 104 - Height = 27 + Height = 23 Top = 6 Width = 80 EditLabel.AnchorSideLeft.Control = LabeledEditSearch @@ -395,10 +395,10 @@ object SimbaForm: TSimbaForm EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch - EditLabel.Left = 66 - EditLabel.Height = 18 - EditLabel.Top = 10 - EditLabel.Width = 35 + EditLabel.Left = 71 + EditLabel.Height = 16 + EditLabel.Top = 9 + EditLabel.Width = 30 EditLabel.Caption = 'Find: ' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -413,7 +413,7 @@ object SimbaForm: TSimbaForm Left = 320 Height = 19 Top = 7 - Width = 93 + Width = 80 Caption = 'Match case' OnClick = CheckBoxMatchCaseClick TabOrder = 1 @@ -421,38 +421,38 @@ object SimbaForm: TSimbaForm end object SplitterFunctionList: TSplitter Left = 150 - Height = 359 + Height = 362 Top = 0 Width = 5 OnCanResize = SplitterFunctionListCanResize Visible = False end inline frmFunctionList: TFunctionListFrame - Height = 359 + Height = 362 Width = 150 - ClientHeight = 359 + ClientHeight = 362 ClientWidth = 150 OnEndDock = nil TabOrder = 3 inherited FunctionList: TTreeView - Height = 310 - Top = 22 + Height = 319 + Top = 20 Width = 150 - DefaultItemHeight = 19 + DefaultItemHeight = 17 OnChange = FunctionListChange OnEnter = FunctionListEnter OnExit = FunctionListExit end inherited editSearchList: TEdit - Height = 27 - Top = 332 + Height = 23 + Top = 339 Width = 150 OnExit = editSearchListExit OnKeyDown = editSearchListKeyDown OnKeyPress = editSearchListKeyPress end inherited FunctionListLabel: TLabel - Height = 18 + Height = 16 Width = 146 end end @@ -3006,6 +3006,7 @@ object SimbaForm: TSimbaForm Caption = '&Extensions' OnExecute = ActionExtensionsExecute OnUpdate = ActionExtensionsUpdate + Visible = False end object ActionPascalScript: TAction Caption = 'PascalScript' diff --git a/Projects/Simba/simbaunit.pas b/Projects/Simba/simbaunit.pas index 904d787..eac81c7 100644 --- a/Projects/Simba/simbaunit.pas +++ b/Projects/Simba/simbaunit.pas @@ -51,8 +51,9 @@ uses SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynEditMarkupHighAll, LMessages, Buttons, mmisc, stringutil,mufasatypesutil, mufasabase, - about, framefunctionlist, ocr, updateform, Simbasettings, psextension, virtualextension, - extensionmanager, settingssandbox, + about, framefunctionlist, ocr, updateform, Simbasettings, + {$IFDEF USE_EXTENSIONS}psextension, virtualextension, extensionmanager,{$ENDIF} + settingssandbox, v_ideCodeParser, v_ideCodeInsight, CastaliaPasLexTypes, // Code completion units CastaliaSimplePasPar, v_AutoCompleteForm, // Code completion units @@ -61,7 +62,7 @@ uses settings, updater; const - SimbaVersion = 830; + SimbaVersion = 970; interp_PS = 0; //PascalScript interp_RT = 1; //RUTIS @@ -410,6 +411,7 @@ type OpenFileData : TOpenFileData; WriteFileData : TWriteFileData; ScriptStartData : TScriptStartData; + procedure UpdateInterpreter; procedure HandleConnectionData; procedure HandleOpenFileData; @@ -418,7 +420,7 @@ type function GetInterpreter: Integer; function GetDefScriptPath: string; function GetScriptPath : string; - function GetExtPath: string; + {$IFDEF USE_EXTENSIONS}function GetExtPath: string;{$ENDIF} function GetFontPath: String; function GetHighlighter: TSynCustomHighlighter; function GetIncludePath: String; @@ -428,7 +430,7 @@ type function GetShowCodeCompletionAuto: Boolean; function GetSimbaNews: String; procedure SetDefScriptPath(const AValue: string); - procedure SetExtPath(const AValue: string); + {$IFDEF USE_EXTENSIONS}procedure SetExtPath(const AValue: string);{$ENDIF} procedure SetFontPath(const AValue: String); procedure SetIncludePath(const AValue: String); procedure SetInterpreter(const AValue: Integer); @@ -501,7 +503,7 @@ type property IncludePath : String read GetIncludePath write SetIncludePath; property FontPath : String read GetFontPath write SetFontPath; property PluginPath : string read GetPluginPath write SetPluginPath; - property ExtPath : string read GetExtPath write SetExtPath; + {$IFDEF USE_EXTENSIONS}property ExtPath : string read GetExtPath write SetExtPath;{$ENDIF} property ScriptDir : string read GetScriptPath write SetScriptPath; property DefScriptPath : string read GetDefScriptPath write SetDefScriptPath; property CurrHighlighter : TSynCustomHighlighter read GetHighlighter; @@ -545,7 +547,7 @@ uses InterfaceBase, bitmapconv, bitmaps, - extensionmanagergui, + {$IFDEF USE_EXTENSIONS}extensionmanagergui,{$ENDIF} colourhistory, math @@ -744,6 +746,7 @@ begin end; procedure TSimbaForm.HandleConnectionData; +{$IFDEF USE_EXTENSIONS} var Args : TVariantArray; begin @@ -758,6 +761,9 @@ begin on e : Exception do mDebugLn('ERROR in HandleConnectiondata: ' + e.message); end; +{$ELSE} +begin +{$ENDIF} end; function TSimbaForm.GetInterpreter: Integer; @@ -781,6 +787,7 @@ begin end; procedure TSimbaForm.HandleOpenFileData; +{$IFDEF USE_EXTENSIONS} var Args : TVariantArray; begin @@ -795,9 +802,13 @@ begin on e : Exception do mDebugLn('ERROR in HandleOpenFileData: ' + e.message); end; +{$ELSE} +begin +{$ENDIF} end; procedure TSimbaForm.HandleWriteFileData; +{$IFDEF USE_EXTENSIONS} var Args : TVariantArray; begin @@ -812,9 +823,13 @@ begin on e : Exception do mDebugLn('ERROR in HandleWriteFileData: ' + e.message); end; +{$ELSE} +begin +{$ENDIF} end; procedure TSimbaForm.HandleScriptStartData; +{$IFDEF USE_EXTENSIONS} var Args : TVariantArray; begin @@ -829,6 +844,9 @@ begin on e : Exception do mDebugLn('ERROR in HandleScriptStartData: ' + e.message); end; +{$ELSE} +begin +{$ENDIF} end; procedure TSimbaForm.ProcessDebugStream(Sender: TObject); @@ -1361,7 +1379,7 @@ begin CreateSetting('Settings/CodeHints/ShowAutomatically','True'); CreateSetting('Settings/CodeCompletion/ShowAutomatically','True'); CreateSetting('Settings/SourceEditor/LazColors','True'); - CreateSetting('Settings/Extensions/FileExtension','sex'); + {$IFDEF USE_EXTENSIONS}CreateSetting('Settings/Extensions/FileExtension','sex');{$ENDIF} CreateSetting('Settings/Updater/RemoteLink',SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF}); CreateSetting('Settings/Updater/RemoteVersionLink',SimbaURL + 'Version'); @@ -1372,8 +1390,10 @@ begin {Creates the paths and returns the path} PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS)); + {$IFDEF USE_EXTENSIONS} extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); CreateSetting('Extensions/ExtensionCount','0'); + {$ENDIF} CreateSetting('LastConfig/MainForm/Position',''); CreateSetting('LastConfig/MainForm/State','Normal'); {$ifdef MSWindows} @@ -1387,10 +1407,12 @@ begin CreateDir(FontPath); if not DirectoryExists(PluginsPath) then CreateDir(PluginsPath); + {$IFDEF USE_EXTENSIONS} if not DirectoryExists(extensionsPath) then CreateDir(extensionsPath); if not DirectoryExists(ExtPath) then CreateDir(ExtPath); + {$ENDIF} if not DirectoryExists(ScriptDir) then CreateDir(ScriptDir); SettingsForm.SettingsTreeView.Items.GetFirstNode.Expand(false); @@ -1491,19 +1513,21 @@ begin else SetSetting('LastConfig/Console/Visible','False'); {$endif} + {$IFDEF USE_EXTENSIONS} SetSetting('Extensions/ExtensionCount',inttostr(ExtManager.Extensions.Count)); for i := 0 to ExtManager.Extensions.Count-1 do begin; - path :='Extensions/Extension' + inttostr(I); SetSetting(Path + '/Path',TVirtualSimbaExtension(ExtManager.Extensions[i]).Filename); SetSetting(Path + '/Enabled',BoolToStr(TVirtualSimbaExtension(ExtManager.Extensions[i]).Enabled,True)); end; + {$ENDIF} SaveToXML(SimbaSettingsFile); end; end; procedure TSimbaForm.LoadExtensions; +{$IFDEF USE_EXTENSIONS} var extCount : integer; function LoadExtension(Number : integer) : boolean; @@ -1551,6 +1575,9 @@ begin str := LoadSettingDef('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex'); ExtManager.LoadPSExtensionsDir(str,str2); +{$ELSE} +begin +{$ENDIF} end; procedure TSimbaForm.AddRecentFile(const filename: string); @@ -1648,26 +1675,30 @@ begin Thread.Client.IOManager.SetTarget(Selector.LastPick); loadFontsOnScriptStart := (lowercase(LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True')) = 'true'); - // Copy our current fonts - if not assigned(Self.OCR_Fonts) and loadFontsOnScriptStart and DirectoryExists(fontPath) then + + if (loadFontsOnScriptStart) then begin - Self.OCR_Fonts := TMOCR.Create(Thread.Client); - OCR_Fonts.InitTOCR(fontPath); - Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts - end else - if assigned(Self.OCR_Fonts) and loadFontsOnScriptStart then + if ((not (Assigned(OCR_Fonts))) and DirectoryExists(fontPath)) then + begin + OCR_Fonts := TMOCR.Create(Thread.Client); + OCR_Fonts.InitTOCR(fontPath); + end; + + if (Assigned(OCR_Fonts)) then Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts; + end; { We pass the entire settings to the script; it will then create a Sandbox for settings that are exported to the script. This way we can access all - the settings from the PSTHread, and scripts can only access limited + the settings from the PSThread, and scripts can only access limited resources. Hopefully this won't cause any form / thread related problems? (Settings doesn't use the Settings form, iirc) Well, it was like this previously as well, we just passed a sandbox to it directly, but the sandbox still called Settings. } Thread.SetSettings(SettingsForm.Settings, SimbaSettingsFile); + Thread.OpenConnectionEvent:=@ThreadOpenConnectionEvent; Thread.WriteFileEvent:=@ThreadWriteFileEvent; Thread.OpenFileEvent:=@ThreadOpenFileEvent; @@ -1830,15 +1861,17 @@ end; procedure TSimbaForm.ActionExtensionsExecute(Sender: TObject); begin + {$IFDEF USE_EXTENSIONS} if not ExtensionsForm.Showing then ExtensionsForm.Show else ExtensionsForm.Hide; + {$ENDIF} end; procedure TSimbaForm.ActionExtensionsUpdate(Sender: TObject); begin - TAction(Sender).Checked := ExtensionsForm.Showing; + {$IFDEF USE_EXTENSIONS}TAction(Sender).Checked := ExtensionsForm.Showing;{$ENDIF} end; procedure TSimbaForm.ActionFindNextExecute(Sender: TObject); @@ -2308,7 +2341,7 @@ begin end; FunctionListTimer.Enabled:= false; CloseAction := caFree; - FreeAndNil(ExtManager); + {$IFDEF USE_EXTENSIONS}FreeAndNil(ExtManager);{$ENDIF} end; procedure CCFillCore; @@ -2410,6 +2443,7 @@ begin UpdateTimer.OnTimer:= @UpdateTimerCheck; Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); + {$IFDEF USE_EXTENSIONS}Application.CreateForm(TExtensionsForm, ExtensionsForm);{$ENDIF} if FileExistsUTF8(SimbaSettingsFile) then begin @@ -2464,13 +2498,15 @@ begin FillThread.Resume; //Load the extensions - LoadExtensions; + {$IFDEF USE_EXTENSIONS}LoadExtensions;{$ENDIF} UpdateTitle; {$IFNDEF USE_RUTIS} MenuItemRUTIS.Enabled:=False; {$ENDIF} + + {$IFDEF USE_EXTENSIONS}ActionExtensions.Visible := True;{$ENDIF} self.EndFormUpdate; if SettingsForm.Oops then @@ -2488,8 +2524,10 @@ begin for i := 0 to high(RecentFileItems) do RecentFileItems[i].Free; - if ExtManager <> nil then - FreeAndNil(extmanager); + {$IFDEF USE_EXTENSIONS} + if ExtManager <> nil then + FreeAndNil(extmanager); + {$ENDIF} Tabs.Free; @@ -2501,6 +2539,10 @@ begin { Free the plugins } PluginsGlob.Free; + { Free Fonts } + if (Assigned(OCR_Fonts)) then + OCR_Fonts.Free; + SetLength(DebugStream, 0); DebugCriticalSection.Free; @@ -2795,10 +2837,12 @@ begin SetSetting('Settings/SourceEditor/DefScriptPath',AValue,True); end; +{$IFDEF USE_EXTENSIONS} procedure TSimbaForm.SetExtPath(const AValue: string); begin SetSetting('Settings/Extensions/Path',AValue,true); end; +{$ENDIF} procedure TSimbaForm.NewsTimerTimer(Sender: TObject); var @@ -2828,6 +2872,11 @@ var c, x, y: Integer; cobj: TColourPickerObject; begin + if Picker.Picking then + begin + formWriteln('Error: Already picking a colour'); + exit; + end; Picker.Pick(c, x, y); cobj := TColourPickerObject.Create(c, Classes.Point(x,y), ''); @@ -2928,6 +2977,7 @@ end; procedure TSimbaForm.PickerPick(Sender: TObject; const Colour, colourx, coloury: integer); +{$IFDEF USE_EXTENSIONS} var Args : TVariantArray; begin @@ -2936,6 +2986,9 @@ begin Args[1] := Colourx; Args[2] := Coloury; ExtManager.HandleHook(EventHooks[SExt_OnColourPick].HookName,Args); +{$ELSE} +begin +{$ENDIF} end; procedure TSimbaForm.PopupItemFindClick(Sender: TObject); @@ -2969,10 +3022,12 @@ begin Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+'Fonts' + DS))); end; +{$IFDEF USE_EXTENSIONS} function TSimbaForm.GetExtPath: string; begin - result :=IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Extensions/Path', ExpandFileName(MainDir+DS+'Extensions' + DS))); + Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Extensions/Path', ExpandFileName(MainDir+DS+'Extensions' + DS))); end; +{$ENDIF} function TSimbaForm.GetHighlighter: TSynCustomHighlighter; begin @@ -3122,7 +3177,6 @@ begin if Assigned(self.OCR_Fonts) then self.OCR_Fonts.Free; FormWriteln('Freeing the current fonts. Creating new ones now'); - // XXX: Can this cause problems when running scripts? Self.OCR_Fonts := TMOCR.Create(nil); OCR_Fonts.InitTOCR(fontPath); end; @@ -3292,7 +3346,8 @@ begin else InitialDir := ScriptDir; Options := [ofAllowMultiSelect, ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofEnableSizing, ofViewDetail]; - Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' +LoadSettingDef('Settings/Extensions/FileExtension','sex')+ + Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt' + + {$IFDEF USE_EXTENSIONS}';*.' + LoadSettingDef('Settings/Extensions/FileExtension', 'sex') + {$ENDIF} '|Any files|*.*'; if Execute then begin @@ -3399,8 +3454,8 @@ begin InitialDir := ExtractFileDir(CurrScript.ScriptFile) else InitialDir := ScriptDir; - filter := 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' + - LoadSettingDef('Settings/Extensions/FileExtension','sex')+ + filter := 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt' + + {$IFDEF USE_EXTENSIONS}';*.' + LoadSettingDef('Settings/Extensions/FileExtension','sex') + {$ENDIF} '|Any files|*.*'; if Execute then begin; diff --git a/Projects/libmml/libmml.lpr b/Projects/libmml/libmml.lpr index 4260876..152b06c 100644 --- a/Projects/libmml/libmml.lpr +++ b/Projects/libmml/libmml.lpr @@ -15,6 +15,11 @@ Const MOUSE_UP = 0; MOUSE_DOWN = 1; +{ + Global variables. + To actually read the last_error, make sure you copy it to a safe place + directly after the function call. +} var last_error: String; debug: boolean; @@ -23,28 +28,28 @@ var function init: integer; cdecl; begin - last_error := ''; - debug := true; - result := RESULT_OK; + last_error := ''; + debug := true; + result := RESULT_OK; end; procedure set_last_error(s: string); begin - last_error := s; - if debug then - writeln('ERROR: ' + s); + last_error := s; + if debug then + writeln('ERROR: ' + s); end; { Validate the TClient. If it is NULL, set last error and return false } function validate_client(C: TClient): boolean; inline; begin - result := Assigned(C); - if not result then - begin - last_error := 'PClient is NULL'; - if debug then - writeln(last_error); - end; + result := Assigned(C); + if not result then + begin + last_error := 'PClient is NULL'; + if debug then + writeln(last_error); + end; end; { @@ -55,42 +60,42 @@ function create_client: PtrUInt; cdecl; var C: TClient; begin - try - C := TClient.Create(''); - Result := PtrUInt(C); - except on e : Exception do - begin - // FIXME UINT negative - result := PtrUInt(RESULT_ERROR); - set_last_error(e.message); - end; - end; - writeln(format('C: %d, IOManager: %d', [PtrUInt(C), PtrUInt(C.IOManager)])); + try + C := TClient.Create(''); + Result := PtrUInt(C); + except on e : Exception do + begin + // FIXME UINT negative + result := PtrUInt(RESULT_ERROR); + set_last_error(e.message); + end; + end; + writeln(format('C: %d, IOManager: %d', [PtrUInt(C), PtrUInt(C.IOManager)])); end; { Destroy a TClient } function destroy_client(C: TClient): integer; cdecl; begin - try - C.Free; - except on e : Exception do - begin - result := RESULT_ERROR; - set_last_error(e.message); - end; - end; + try + C.Free; + except on e : Exception do + begin + result := RESULT_ERROR; + set_last_error(e.message); + end; + end; end; { Set (verbose) debug on/off } procedure set_debug(v: Boolean); cdecl; begin - debug := v; + debug := v; end; { Get debug } function get_debug: boolean; cdecl; begin - exit(debug); + exit(debug); end; { @@ -101,40 +106,40 @@ end; } function get_last_error: pchar; cdecl; begin - exit(@last_error[1]); + exit(@last_error[1]); end; { Turn an array into a pointer. The pointer memory is not managed by FPC, so we can pass it along happily. It'll have to be freed by the external control though } function array_to_ptr(ptr: Pointer; size: PtrUInt; objsize: PtrUInt): Pointer; cdecl; begin - result := GetMem(objsize * size); - Move(ptr^, result^, objsize * size); + result := GetMem(objsize * size); + Move(ptr^, result^, objsize * size); end; { Free memory previously allocated by libMML } function free_ptr(ptr: pointer): boolean; cdecl; begin - result := Assigned(ptr); - if not result then - begin - set_last_error('TClient is NULL'); - if debug then - writeln(last_error); - end else - FreeMem(ptr); + result := Assigned(ptr); + if not result then + begin + set_last_error('TClient is NULL'); + if debug then + writeln(last_error); + end else + FreeMem(ptr); end; { Allocate memory with libMML } function alloc_mem(size, objsize: PtrUInt): Pointer; cdecl; begin - result := GetMem(size * objsize); + result := GetMem(size * objsize); end; { Reallocate memory with libMML } function realloc_mem(ptr: Pointer; size, objsize: PtrUInt): Pointer; cdecl; begin - result := ReAllocMem(ptr, size*objsize); + result := ReAllocMem(ptr, size*objsize); end; { Mouse } @@ -143,34 +148,32 @@ end; function get_mouse_pos(C: TClient; var t: tpoint): integer; cdecl; begin - if not validate_client(C) then + if not validate_client(C) then + exit(RESULT_ERROR); + + try + C.IOManager.GetMousePos(t.x,t.y); + result := RESULT_OK; + except on e : Exception do begin - exit(RESULT_ERROR); - end; - - try - C.IOManager.GetMousePos(t.x,t.y); - result := RESULT_OK; - except on e : Exception do - begin - result := RESULT_ERROR; - set_last_error(e.Message); - end; + result := RESULT_ERROR; + set_last_error(e.Message); end; + end; end; { Set mouse position of client C to point t } function set_mouse_pos(C: TClient; var t: tpoint): integer; cdecl; begin - try - C.IOManager.MoveMouse(t.x,t.y); - result := RESULT_OK; - except on e : Exception do + try + C.IOManager.MoveMouse(t.x,t.y); + result := RESULT_OK; + except on e : Exception do begin result := RESULT_ERROR; set_last_error(e.Message); end; - end; + end; end; @@ -187,38 +190,38 @@ end; { Return the state of a mouse button given client C } function get_mouse_button_state(C: TClient; But: Integer): Integer; cdecl; begin - try - if C.IOManager.IsMouseButtonDown(ConvIntClickType(But)) then - result := MOUSE_DOWN - else - result := MOUSE_UP; - except on e : Exception do + try + if C.IOManager.IsMouseButtonDown(ConvIntClickType(But)) then + result := MOUSE_DOWN + else + result := MOUSE_UP; + except on e : Exception do begin - result := RESULT_ERROR; - set_last_error(e.Message); - end; + result := RESULT_ERROR; + set_last_error(e.Message); end; + end; end; { Set the state of a mouse button given client C } function set_mouse_button_state(C: TClient; But, State, X, Y: Integer): Integer; cdecl; begin - try - if State = MOUSE_UP then - begin - C.IOManager.ReleaseMouse(X, Y, ConvIntClickType(But)); - result := RESULT_OK; - end else if state = MOUSE_DOWN then - begin - C.IOManager.HoldMouse(X, Y, ConvIntClickType(But)); - result := RESULT_OK; - end; - except on e : Exception do + try + if State = MOUSE_UP then begin - result := RESULT_ERROR; - set_last_error(e.Message); + C.IOManager.ReleaseMouse(X, Y, ConvIntClickType(But)); + result := RESULT_OK; + end else if state = MOUSE_DOWN then + begin + C.IOManager.HoldMouse(X, Y, ConvIntClickType(But)); + result := RESULT_OK; end; + except on e : Exception do + begin + result := RESULT_ERROR; + set_last_error(e.Message); end; + end; end; @@ -227,52 +230,52 @@ end; function get_color(C: TClient; x, y: Integer; out color: Integer): Integer; cdecl; begin - try - color := C.IOManager.GetColor(x, y); - if color > -1 then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + color := C.IOManager.GetColor(x, y); + if color > -1 then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; { Find color on client C in area (x1,y1,x2,y2) and return coordinate (if any) in x, y } function find_color(C: TClient; var x, y: Integer; color, x1, y1, x2, y2: Integer): Integer; cdecl; begin - try - if C.MFinder.FindColor(x, y, color, x1, y1, x2, y2) then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + if C.MFinder.FindColor(x, y, color, x1, y1, x2, y2) then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.Message); - result := RESULT_ERROR; - end; + set_last_error(e.Message); + result := RESULT_ERROR; end; + end; end; function find_color_tolerance(C: TClient; var x, y: Integer; color: Integer; tol, x1, y1, x2, y2: Integer): Integer; cdecl; begin - try - if C.MFinder.FindColorTolerance(x, y, color, x1, y1, x2, y2, tol) then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + if C.MFinder.FindColorTolerance(x, y, color, x1, y1, x2, y2, tol) then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.Message); - result := RESULT_ERROR; - end; + set_last_error(e.Message); + result := RESULT_ERROR; end; + end; end; function find_color_tolerance_optimised(C: TClient; var x, y: Integer; @@ -280,18 +283,18 @@ function find_color_tolerance_optimised(C: TClient; var x, y: Integer; x1, y1, x2, y2: Integer; tol: Integer): Integer; cdecl; begin - try - if C.MFinder.FindColorToleranceOptimised(x, y, col, x1, y1, x2, y2, - tol) then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + if C.MFinder.FindColorToleranceOptimised(x, y, col, x1, y1, x2, y2, + tol) then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; function find_colors(C: TClient; var ptr: PPoint; var len: Integer; @@ -299,27 +302,27 @@ function find_colors(C: TClient; var ptr: PPoint; var len: Integer; var TPA: TPointArray; begin - setlength(TPA, 0); - try - C.MFinder.FindColors(TPA, color, x1, y1, x2, y2); - except on e : Exception do + setlength(TPA, 0); + try + C.MFinder.FindColors(TPA, color, x1, y1, x2, y2); + except on e : Exception do begin - set_last_error(e.Message); - result := RESULT_ERROR; + set_last_error(e.Message); + result := RESULT_ERROR; end; - end; - - len := Length(TPA); - if len > 0 then - result := RESULT_OK - else - begin - setlength(tpa, 0); - exit(RESULT_FALSE); - end; - - ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); + end; + + len := Length(TPA); + if len > 0 then + result := RESULT_OK + else + begin setlength(tpa, 0); + exit(RESULT_FALSE); + end; + + ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); + setlength(tpa, 0); end; function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer; @@ -327,26 +330,26 @@ function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer; var TPA: TPointArray; begin - try - C.MFinder.FindColorsTolerance(TPA, color, x1, y1, x2, y2, tol); - except on e : Exception do + try + C.MFinder.FindColorsTolerance(TPA, color, x1, y1, x2, y2, tol); + except on e : Exception do begin - set_last_error(e.Message); - result := RESULT_ERROR; - end; - end; - - len := Length(TPA); - if len > 0 then - result := RESULT_OK - else - begin - setlength(tpa, 0); - exit(RESULT_FALSE); + set_last_error(e.Message); + result := RESULT_ERROR; end; + end; - ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); - setlength(TPA, 0); + len := Length(TPA); + if len > 0 then + result := RESULT_OK + else + begin + setlength(tpa, 0); + exit(RESULT_FALSE); + end; + + ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); + setlength(TPA, 0); end; function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint; @@ -356,184 +359,184 @@ function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint; var TPA: TPointArray; begin - try - C.MFinder.FindColorsToleranceOptimised(TPA, col, x1, y1, x2, y2, tol); - except on e : Exception do + try + C.MFinder.FindColorsToleranceOptimised(TPA, col, x1, y1, x2, y2, tol); + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; + set_last_error(e.message); + result := RESULT_ERROR; end; - end; - - len := Length(TPA); - if len > 0 then - result := RESULT_OK - else - begin - setlength(tpa, 0); - exit(RESULT_FALSE); - end; - - ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); - setlength(TPA, 0); + end; + + len := Length(TPA); + if len > 0 then + result := RESULT_OK + else + begin + setlength(tpa, 0); + exit(RESULT_FALSE); + end; + + ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); + setlength(TPA, 0); end; function similar_colors(C: TClient; col1, col2, tol: Integer): Integer; cdecl; begin - try - if C.MFinder.SimilarColors(col1, col2, tol) then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + if C.MFinder.SimilarColors(col1, col2, tol) then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_FALSE; - end; + set_last_error(e.message); + result := RESULT_FALSE; end; + end; end; function count_color(C: TClient; out count: Integer; Color, xs, ys, xe, ye: Integer): Integer; cdecl; begin - try - count := C.MFinder.CountColor(Color, xs, ys, xe, ye); - if count > 0 then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + count := C.MFinder.CountColor(Color, xs, ys, xe, ye); + if count > 0 then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; function count_color_tolerance(C: TClient; out count: Integer; col: Integer; xs, ys, xe, ye, tol: Integer): Integer; cdecl; begin - try - count := C.MFinder.CountColorTolerance(col, xs, ys, xe, ye, tol); - except on e : Exception do + try + count := C.MFinder.CountColorTolerance(col, xs, ys, xe, ye, tol); + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; - if count > 0 then - result := RESULT_OK - else - result := RESULT_FALSE; + if count > 0 then + result := RESULT_OK + else + result := RESULT_FALSE; end; function find_color_spiral(C: TClient; var x, y: Integer; col, xs, ys, xe, ye: Integer): Integer; cdecl; begin - try - if C.MFinder.FindColorSpiral(x, y, col, xs, ys, xe, ye) then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + if C.MFinder.FindColorSpiral(x, y, col, xs, ys, xe, ye) then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; function find_color_spiral_tolerance(C: TClient; var x, y: Integer; col, xs, ys, xe, ye: Integer; tol: Integer): Integer; cdecl; begin - try - if C.MFinder.FindColorSpiralTolerance(x, y, col, xs, ys, xe, ye, - tol) then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + if C.MFinder.FindColorSpiralTolerance(x, y, col, xs, ys, xe, ye, + tol) then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; function find_colored_area(C: TClient; var x, y: Integer; col, xs, ys, xe, ye, minA: Integer): Integer; cdecl; begin - try - if C.MFinder.FindColoredArea(x, y, col, xs, ys, xe, ye, minA) then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + if C.MFinder.FindColoredArea(x, y, col, xs, ys, xe, ye, minA) then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; function find_colored_area_tolerance(C: TClient; var x, y: Integer; col, xs, ys, xe, ye, minA: Integer; tol: Integer): Integer; cdecl; begin - try - if C.MFinder.FindColoredAreaTolerance(x, y, col, - xs, ys, xe, ye, minA, tol) then - result := RESULT_OK - else - result := RESULT_FALSE; - except on e : Exception do + try + if C.MFinder.FindColoredAreaTolerance(x, y, col, + xs, ys, xe, ye, minA, tol) then + result := RESULT_OK + else + result := RESULT_FALSE; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; function set_tolerance_speed(C: TClient; nCTS: Integer): Integer; cdecl; begin - try - C.MFinder.SetToleranceSpeed(nCTS); - result := RESULT_OK; - except on e : Exception do + try + C.MFinder.SetToleranceSpeed(nCTS); + result := RESULT_OK; + except on e : Exception do begin - set_last_error(e.message); - result := RESULT_ERROR; - end; + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; function get_tolerance_speed(C: TClient; out cts: Integer): Integer; cdecl; begin - try - cts := C.MFinder.GetToleranceSpeed; - result := RESULT_OK; - except on e: Exception do - begin; - set_last_error(e.message); - result := RESULT_ERROR; + try + cts := C.MFinder.GetToleranceSpeed; + result := RESULT_OK; + except on e: Exception do + begin + set_last_error(e.message); + result := RESULT_ERROR; end - end; + end; end; function set_tolerance_speed_2_modifiers(C: TClient; nHue, nSat: Extended): Integer; cdecl; begin - try - C.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat); - result := RESULT_OK; - except on e : Exception do - begin; - set_last_error(e.message); - result := RESULT_ERROR; - end; + try + C.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat); + result := RESULT_OK; + except on e : Exception do + begin + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended; @@ -541,17 +544,17 @@ function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended; var h, s: Extended; begin - try - C.MFinder.GetToleranceSpeed2Modifiers(h, s); - hueMod := h; - satMod := s; - result := RESULT_OK; - except on e : Exception do - begin; - set_last_error(e.message); - result := RESULT_ERROR; - end; + try + C.MFinder.GetToleranceSpeed2Modifiers(h, s); + hueMod := h; + satMod := s; + result := RESULT_OK; + except on e : Exception do + begin + set_last_error(e.message); + result := RESULT_ERROR; end; + end; end; { DTM } @@ -564,53 +567,53 @@ function create_dtm(PointLen: integer; Points: PMDTMPoint; DTM: TMDTM): integer; var i: integer; begin - DTM := TMDTM.Create; - for i := 0 to PointLen - 1 do - DTM.AddPoint(Points[i]); - - if DTM.Valid then - exit(RESULT_OK); - - DTM.Free; - set_last_error('Invalid DTM'); - result := RESULT_ERROR; + DTM := TMDTM.Create; + for i := 0 to PointLen - 1 do + DTM.AddPoint(Points[i]); + + if DTM.Valid then + exit(RESULT_OK); + + DTM.Free; + set_last_error('Invalid DTM'); + result := RESULT_ERROR; end; { Delete a MDTM. Don't delete it if it is managed! use remove_dtm instead } function delete_dtm(C: TClient; DTM: TMDTM): integer; cdecl; begin - if not assigned(DTM) then - begin - set_last_error('DTM is NULL'); - exit(RESULT_ERROR); - end; - - DTM.Free; - - result := RESULT_OK; + if not assigned(DTM) then + begin + set_last_error('DTM is NULL'); + exit(RESULT_ERROR); + end; + + DTM.Free; + + result := RESULT_OK; end; { Add a previously created DTM to the DTM Manager } function add_dtm(C: TClient; DTM: TMDTM; var index: integer): integer; cdecl; begin - if not assigned(DTM) then - begin - set_last_error('DTM is NULL'); - exit(RESULT_ERROR); - end; - - try - index := C.MDTMs.AddDTM(DTM); - exit(RESULT_OK); - except on e : Exception do - result := RESULT_ERROR; - end; + if not assigned(DTM) then + begin + set_last_error('DTM is NULL'); + exit(RESULT_ERROR); + end; + + try + index := C.MDTMs.AddDTM(DTM); + exit(RESULT_OK); + except on e : Exception do + result := RESULT_ERROR; + end; end; { Remove a previously added DTM from the DTM manager. This also frees the DTM } function remove_dtm(C: TClient; DTMi: integer): integer; cdecl; begin - C.MDTMs.FreeDTM(DTMi); + C.MDTMs.FreeDTM(DTMi); end; { Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. } @@ -619,19 +622,19 @@ function find_dtm(C: TClient; DTMi: integer; var x, y: integer; x1, y1, x2, var res: boolean; begin - try - res := C.MFinder.FindDTM(C.MDTMs.DTM[DTMi], x, y, x1, y1, x2, y2); - except on e : Exception do + try + res := C.MFinder.FindDTM(C.MDTMs.DTM[DTMi], x, y, x1, y1, x2, y2); + except on e : Exception do begin; - result := RESULT_ERROR; - set_last_error(e.Message); + result := RESULT_ERROR; + set_last_error(e.Message); end; - end; - - if res then - result := RESULT_OK - else - result := RESULT_FALSE; + end; + + if res then + result := RESULT_OK + else + result := RESULT_FALSE; end; { Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. } @@ -642,46 +645,46 @@ var len: integer; TPA: TPointArray; begin - try - res := C.MFinder.FindDTMs(C.MDTMs.DTM[DTMi], TPA, x1, y1, x2, y2); - except on e : Exception do - begin; - result := RESULT_ERROR; - set_last_error(e.Message); - end; - end; - - len := Length(TPA); - if len > 0 then - result := RESULT_OK - else - begin - setlength(tpa, 0); - exit(RESULT_FALSE); - end; - - ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); - setlength(TPA, 0); + try + res := C.MFinder.FindDTMs(C.MDTMs.DTM[DTMi], TPA, x1, y1, x2, y2); + except on e : Exception do + begin; + result := RESULT_ERROR; + set_last_error(e.Message); + end; + end; + + len := Length(TPA); + if len > 0 then + result := RESULT_OK + else + begin + setlength(tpa, 0); + exit(RESULT_FALSE); + end; + + ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); + setlength(TPA, 0); end; function set_array_target(C: TClient; Arr: PRGB32; Size: TPoint): integer; cdecl; begin - if not assigned(Arr) then + if not assigned(Arr) then + begin + set_last_error('Arr is not assigned'); + exit(RESULT_FALSE); + end; + + try + C.IOManager.SetTarget(Arr, Size); + result := RESULT_OK; + except on e : Exception do begin - set_last_error('Arr is not assigned'); - exit(RESULT_FALSE); - end; - - try - C.IOManager.SetTarget(Arr, Size); - result := RESULT_OK; - except on e : Exception do - begin; - set_last_error(e.message); - result := RESULT_FALSE; - end; + set_last_error(e.message); + result := RESULT_FALSE; end; + end; end; exports diff --git a/Units/MMLAddon/colourpicker.pas b/Units/MMLAddon/colourpicker.pas index 800d02b..1cff981 100644 --- a/Units/MMLAddon/colourpicker.pas +++ b/Units/MMLAddon/colourpicker.pas @@ -51,7 +51,12 @@ type procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); - Procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); + procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); + + private + { Are we currently picking? } + FPicking: Boolean; + public manager: TIOManager; { Form components } @@ -68,7 +73,9 @@ type { Handles } InfoHandle, ImageHandle : HDC; + public + property Picking: Boolean read FPicking; property OnPick: TColourPickEvent read FPickEvent write FPickEvent; end; @@ -80,7 +87,8 @@ constructor TMColorPicker.Create(manager: TIOManager); begin inherited Create; - self.manager := manager; + Self.manager := manager; + Self.FPicking := False; end; destructor TMColorPicker.Destroy; @@ -103,12 +111,17 @@ var begin + if self.FPicking then + raise Exception.Create('Pick() has not yet returned, but has been called' + + 'again'); + + Self.FPicking := True; { Disable both of the color pick buttons } w := 0; h := 0; { If the target window isn't valid (closed etc), make the destkop the new window} if not Self.Manager.TargetValid then - self.Manager.SetDesktop; + Self.Manager.SetDesktop; {Desktop is needed for the whole picture} Desktop := TIOManager.Create; @@ -214,6 +227,8 @@ begin Desktop.free; + self.FPicking := False; + { Re-enable the color pick buttons } // Application.MainForm.Enabled := True; // ColourHistoryForm.Enabled := True; diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas index b8db70b..e285d8a 100644 --- a/Units/MMLCore/ocr.pas +++ b/Units/MMLCore/ocr.pas @@ -176,12 +176,15 @@ end; { Get the current pointer to our list of Fonts } function TMOCR.GetFonts:TMFonts; begin - Exit(Self.FFonts); + Result := Self.FFonts; end; { Set new Fonts. We set it to a Copy of NewFonts } procedure TMOCR.SetFonts(const NewFonts: TMFonts); begin + if (Self.FFonts <> nil) then + Self.FFonts.Free; + Self.FFonts := NewFonts.Copy(Self.Client); end; diff --git a/Units/MMLCore/os_linux.pas b/Units/MMLCore/os_linux.pas index 59014e4..94bdeed 100644 --- a/Units/MMLCore/os_linux.pas +++ b/Units/MMLCore/os_linux.pas @@ -413,34 +413,40 @@ implementation result := xmask and ButtonP > 0; end; - procedure TWindow.SendString(str: string); - var - i: integer; - key: byte; - HoldShift : boolean; +procedure TWindow.SendString(str: string); +var + I, L: Integer; + K: Byte; + HoldShift: Boolean; +begin + HoldShift := False; + L := Length(str); + for I := 1 to L do begin - HoldShift := false; - for i := 1 to length(str) do + if (((str[I] >= 'A') and (str[I] <= 'Z')) or + ((str[I] >= '!') and (str[I] <= '&')) or + ((str[I] >= '(') and (str[I] <= '+')) or + (str[I] = ':') or + ((str[I] >= '<') and (str[I] <= '@')) or + ((str[I] >= '^') and (str[I] <= '_')) or + ((str[I] >= '{') and (str[I] <= '~'))) then begin - if((str[i] >= 'A') and (str[i] <= 'Z')) then - begin - HoldKey(VK_SHIFT); - HoldShift:= True; - str[i] := lowerCase(str[i]); - end else - if HoldShift then - begin - HoldShift:= false; - ReleaseKey(VK_SHIFT); - end; - key:= GetKeyCode(str[i]); - HoldKey(key); - //BenLand100: You should probably wait here... - ReleaseKey(key); + HoldKey(VK_SHIFT); + HoldShift := True; end; - if HoldShift then + + K := GetKeyCode(str[I]); + HoldKey(K); + Sleep(20); + ReleaseKey(K); + + if (HoldShift) then + begin + HoldShift := False; ReleaseKey(VK_SHIFT); + end; end; +end; procedure TWindow.HoldKey(key: integer); begin diff --git a/Units/MMLCore/os_windows.pas b/Units/MMLCore/os_windows.pas index 41a7e1a..6d6f77a 100644 --- a/Units/MMLCore/os_windows.pas +++ b/Units/MMLCore/os_windows.pas @@ -366,34 +366,34 @@ begin end; end; - procedure TWindow.SendString(str: string); - var - i: integer; - key: byte; - HoldShift : boolean; +procedure TWindow.SendString(str: string); +var + I, L: integer; + C: Byte; + ScanCode, VK: Word; + Shift: boolean; +begin + L := Length(str); + for I := 1 to L do begin - HoldShift := false; - for i := 1 to length(str) do - begin - if((str[i] >= 'A') and (str[i] <= 'Z')) then - begin - HoldKey(VK_SHIFT); - HoldShift:= True; - str[i] := lowerCase(str[i]); - end else - if HoldShift then - begin - HoldShift:= false; - ReleaseKey(VK_SHIFT); - end; - key:= GetKeyCode(str[i]); - HoldKey(key); - //BenLand100 note: probably should wait here - ReleaseKey(key); - end; - if HoldShift then - ReleaseKey(VK_SHIFT); + VK := VkKeyScan(str[I]); + Shift := (Hi(VK) > 0); + C := LoByte(VK); + ScanCode := MapVirtualKey(C, 0); + if (ScanCode = 0) then + Continue; + + if (Shift) then + Keybd_Event(VK_SHIFT, $2A, 0, 0); + + Keybd_Event(C, ScanCode, 0, 0); + Keybd_Event(C, ScanCode, KEYEVENTF_KEYUP, 0); + + if (Shift) then + Keybd_Event(VK_SHIFT, $2A, KEYEVENTF_KEYUP, 0); end; +end; + procedure TWindow.HoldKey(key: integer); begin keyinput.Down(key);