diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 000000000..765207f06 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,6 @@ +# Customise GitHub Linguist + +# Highlight Inno Setup's .ps files as Pascal +*.ps linguist-language=Pascal +# Include Markdown files in stats +*.md linguist-detectable diff --git a/.gitignore b/.gitignore index 34885dadb..64f314858 100644 --- a/.gitignore +++ b/.gitignore @@ -10,10 +10,6 @@ __history/ # Project specific directories & files -Bin -Exe -Release +_build Src/CodeSnip.cfg Src/AutoGen/IntfExternalObj.pas -Src/Portable/CodeSnipPortable.cfg -Src/Main/AutoGen/IntfExternalObj.pas diff --git a/Build.html b/Build.html index 35d54831c..5dde59363 100644 --- a/Build.html +++ b/Build.html @@ -1,17 +1,17 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + @@ -21,6 +21,9 @@ body { font-family: sans-serif; } + code, pre { + font-size: 1rem; + } dt.spaced { margin-top: 0.5em; } @@ -80,6 +83,13 @@ <h2> XE. Compilation with other compilers is not guaranteed. </p> +<p class="note"> + For an explanation of why <em>CodeSnip</em> still uses Delphi XE see + <a + href="https://github.com/delphidabbler/codesnip-faq/blob/master/SourceCode.md#faq-11" + >FAQ 11</a> of the CodeSnip Compiling & Source Code FAQs. +</p> + <p> The are currently two editions of <em>CodeSnip</em>: the standard edition and the portable edition. They both share the same code base: the different @@ -150,7 +160,7 @@ <h3> </dt> <dd> Type library importer tool. Used to create a Pascal unit that describes - code contained in <code>ExternalObj.idl</code>. + code contained in <code>ExternalObj.ridl</code>. </dd> </dl> @@ -184,10 +194,10 @@ <h3> </h3> <p> - This tool is used to compile version information (<code>.vi</code>) files - into intermediate resource source (<code>.rc</code>) files. Version 2.11.2 - or later is required. - Version Information Editor can be obtained from + This tool is used to compile version information (<code>.vi</code>) files and + any associated macro file(s) into intermediate resource source + (<code>.rc</code>) files. Version 2.15.0 or later is required. Version + Information Editor can be obtained from <a href="https://github.com/delphidabbler/vied/releases" >https://github.com/delphidabbler/vied/releases</a>. @@ -235,8 +245,8 @@ <h3> <p> You can get Inno Setup at <a - href="http://www.jrsoftware.org/isinfo.php" - >http://www.jrsoftware.org/isinfo.php</a>. Choose the Unicode version and + href="https://www.jrsoftware.org/isinfo.php" + >https://www.jrsoftware.org/isinfo.php</a>. Choose the Unicode version and ensure that the ISPP pre-processor is installed. If you already have the ANSI version the Unicode version can be installed alongside it - just use a different install directory and program group name. @@ -274,11 +284,19 @@ <h3> </h3> <p> - This program is used to create <em>CodeSnip</em>'s release file. - You can get a Windows command line version at + This program is used to create <em>CodeSnip</em>'s release file. The InfoZip + version of zip is required. You can get a Windows command line version at <a href="http://stahlforce.com/dev/index.php?tool=zipunzip" - >http://stahlforce.com/dev/index.php?tool=zipunzip</a>. + >http://stahlforce.com/dev/index.php?tool=zipunzip</a>. +</p> + +<p class="note"> + <strong>Warning:</strong> The above link is <code>http</code> only. If you or + your browser object to the insecure link you can download an identical version + from delphidabbler.com, using the <code>https</code> protocol. See <a + href="https://delphidabbler.com/extras/info-zip" + >https://delphidabbler.com/extras/info-zip</a>. </p> <p> @@ -369,30 +387,34 @@ <h3> </h3> <p> - The source code is maintained in the <code><a href="https://github.com/delphidabbler/codesnip">delphidabbler/codesnip</a></code> Git respository on GitHub. -</p> - -<p> - If you are intending to contribute code to the project you need to: + The source code is maintained in the <code><a href="https://github.com/delphidabbler/codesnip">delphidabbler/codesnip</a></code> Git respository on GitHub. Source code can be obtained in three ways: </p> -<ol class="spaced"> - <li> - Fork the project on GitHub. - </li> +<ol> <li> - Create a new branch off the <code>development</code> branch. + <p> + Fork the project from GitHub and then clone your forked repository. + </p> </li> <li> - Make your changes on the branch you created. + <p> + Clone the existing repository using: + </p> + <pre class="cmd"><span class="prompt">></span> git clone https://github.com/delphidabbler/codesnip.git</pre> </li> <li> - Once finished raise a pull request for your code on the <code>delphidabbler/codesnip</code> repo. + <p> + Download the source of a specific release from the project's <a href="https://github.com/delphidabbler/codesnip/releases">Releases</a> section on GitHub – just choose the version you want. + </p> </li> </ol> <p> - If you only intend to use the code for your own purposes you can still fork the repository as above. Alternatively you can download the source code from the project's <a href="https://github.com/delphidabbler/codesnip/releases">Releases</a> section on GitHub – just choose the version you want. + If you are intending to contribute code to the project please read the most up to date version of the project's <a href="https://github.com/delphidabbler/codesnip/blob/develop/README.md">read-me file</a> before doing so. +</p> + +<p class="note"> + <strong>Important:</strong> If you are planning to fork <em>CodeSnip</em> and to develop and release your own application derived from the CodeSnip code base then some changes to the code are required under the terms of the <em>CodeSnip</em> license. See the <a href="#conditions">Conditions For Release of Modified Code</a> section below for details. </p> <h3> @@ -405,56 +427,57 @@ <h3> <pre>./ | - +-- Docs - documentation + +-- Docs - documentation | | - | +-- Design - documents concerning program design + | +-- Design - documents concerning program design | | - | +-- FileFormats - documentation of CodeSnip's file formats + | +-- FileFormats - documentation of CodeSnip's file formats | - +-- Src - main CodeSnip source code + +-- Src - main CodeSnip source code | | - | +-- 3rdParty - third party & DelphiDabbler library source code + | +-- 3rdParty - third party & DelphiDabbler library source code | | - | +-- AutoGen - receives automatically generated code + | +-- AutoGen - receives automatically generated code | | - | +-- Help - help source files + | +-- Help - help source files | | | - | | +-- CSS - CSS code for help files + | | +-- CSS - CSS code for help files | | | - | | +-- HTML - HTML files included in help file + | | +-- HTML - HTML files included in help file | | | - | | +-- Images - images included in help file + | | +-- Images - images included in help file | | - | +-- Install - setup script and support code + | +-- Install - setup script and support code | | | - | | +-- Assets - files required for inclusion in install program + | | +-- Assets - files required for inclusion in install program | | - | +-- Res - container for files that are embedded in resources + | +-- Res - container for files that are embedded in resources | | - | +-- CSS - CSS files + | +-- CSS - CSS files | | - | +-- HTML - HTML files + | +-- HTML - HTML files | | - | +-- Img - image files + | +-- Img - image files + | | | + | | +-- AltBranding - image files used for 3rd party branding | | | - | | +-- Branding - image files used for CodeSnip branding + | | +-- Branding - image files used for CodeSnip branding only | | | - | | +-- Egg - image files for 'Easter Egg' + | | +-- Egg - image files for 'Easter Egg' | | - | +-- Misc - other resources + | +-- Misc - other resources | | - | +-- Scripts - scripting files + | +-- Scripts - scripting files | | - | +-- 3rdParty - 3rd party scripting files + | +-- 3rdParty - 3rd party scripting files | - +-- Tests - contains test code + +-- Tests - contains test code | - +-- Src - test source code + +-- Src - test source code | - +-- DUnit - test source code that uses the DUnit framework</pre> + +-- DUnit - test source code that uses the DUnit framework</pre> <p> - If, by chance you also have <code>Bin</code>, <code>Exe</code> and / or - <code>Release</code> directories don't worry - all will become clear. + If, by chance you also have a <code>_build</code> directory don't worry - all will become clear. Git users may also see the usual <code>.git</code> hidden directory. If you have done some editing in the Delphi IDE you may also see occasional hidden <code>__history</code> folders. @@ -491,19 +514,21 @@ <h3> <pre>./ | - +-- Bin - receives object files for CodeSnip - | - ... - | - +-- Exe - receives executable code and compiled help file - | - +-- Release - receives release files + +-- _build - contains all the build files + | | + | +-- bin - receives object files for CodeSnip + | | + | +-- exe - receives executable code and compiled help file + | | + | +-- release - receives release files + | | + | +-- ~tmp~ - store for temp files ceated in release process | ...</pre> <p> - If the <code>Bin</code> folder already existed, it will have been emptied. - In addition, <code>Make</code> will have created a <code>.cfg</code> file from + If the <code>_build/bin</code> folder already existed, it will have been emptied. + In addition, <code>Make</code> will have created a <code>.cfg</code> file from a template in the <code>Src</code> folder. This <code>.cfg</code> file is needed for DCC32 to run correctly. The file will be ignored by Git. </p> @@ -565,7 +590,7 @@ <h2> You have several options: </p> -<ul class="spaced"> +<ol class="spaced"> <li> Build the <em>CodeSnip</em> Executable </li> @@ -584,10 +609,10 @@ <h2> <li> Clean Up. </li> -</ul> +</ol> <p> - Each of these options is described below. All except the last assume that + Each of these options is described below. All except options 5 and 6 assume that <code>Make config</code> has been run. </p> @@ -618,7 +643,7 @@ <h3> <p> The <em>CodeSnip</em> executable, named <code>CodeSnip.exe</code> will be - placed in the <code>Exe</code> folder. + placed in the <code>_build\exe</code> folder. </p> <h4> @@ -633,7 +658,7 @@ <h4> <pre class="cmd"><span class="prompt">></span> Make -DPORTABLE codesnip</pre> <p> - Again the executable is placed in the <code>Exe</code> folder, but this time + Again the executable is placed in the <code>_build\exe</code> folder, but this time it is named <code>CodeSnip-p.exe</code> </p> @@ -647,13 +672,21 @@ <h3> <pre class="cmd"><span class="prompt">></span> Make help</pre> +<p> + The compiled help file will be written to the <code>_build\exe</code> folder. +</p> + +<p> + The same help file is used for the standard and portable editions. +</p> + <h3> Build the Setup Program </h3> <p> - The setup program requires that the <em>CodeSnip</em> excutable and the - compiled help file are already present in the <code>Exe</code> directory. + The setup program requires that the <em>CodeSnip</em> executable and the + compiled help file are already present in the <code>_build\exe</code> directory. </p> <p> @@ -672,7 +705,7 @@ <h3> <p> The setup program is named <code>CodeSnip-Setup-x.x.x.exe</code>, where x.x.x is the version number extracted from <em>CodeSnip</em>'s version - information. It is placed in the <code>Exe</code> directory. + information. It is placed in the <code>_build\exe</code> directory. </p> <p> @@ -697,6 +730,7 @@ <h3> <p> Make can create zip files containing all the files that are included in a release. + Zip files are written to the <code>_build\release</code> directory. </p> <h4> @@ -704,9 +738,13 @@ <h4> </h4> <p> - The release file for the standard edition of <em>CodeSnip</em> includes the - setup file along with <code>ReadMe.txt</code> from the <code>Docs</code> - directory. Both files must exist. + The release zip file for the standard edition requires that the setup files is already + present in the <code>_build\exe</code> directory. +</p> + +<p> + The release file includes the setup file along with <code>ReadMe.txt</code> + that is automatically generated from <code>Docs\ReadMe-standard.txt</code>. </p> <p> @@ -716,22 +754,33 @@ <h4> <pre class="cmd"><span class="prompt">></span> Make release</pre> <p> - By default the release file is named <code>dd-codesnip.zip</code>. You can + By default the release file is named <code>codesnip-exe.zip</code>. You can change this name by defining the <code>RELEASEFILENAME</code> macro or enviroment variable. For example, you can name the file <code>MyRelease.zip</code> by doing: </p> -<pre class="cmd"><span class="prompt">></span> Make -DRELEASEFILENAME=MyRelease.zip release</pre> +<pre class="cmd"><span class="prompt">></span> Make -DRELEASEFILENAME=MyRelease release</pre> + +<p> + Note that the <code>.zip</code> extension should not be included in the file name. +</p> <h4> Portable edition </h4> <p> - The release file for the portable edition includes the portable executable - file, <code>CodeSnip-p.exe</code>, the help file <code>CodeSnip.chm</code> and - several files from the <code>Docs</code> directory. All must be present. + The release zip file for the portable edition cannot be created until the + <em>CodeSnip</em> excutable and the compiled help file are already present in the + <code>_build\exe</code> directory. +</p> + +<p> + The release file includes the portable executable file, <code>CodeSnip-p.exe</code>, + the help file <code>CodeSnip.chm</code>, <code>Docs\License.html</code> and + <code>ReadMe.txt</code> that is automatically generated from + <code>Docs\ReadMe-portable.txt</code>. </p> <p> @@ -747,7 +796,11 @@ <h4> <code>MyPortableRelease.zip</code> by doing: </p> -<pre class="cmd"><span class="prompt">></span> Make -DPORTABLE -DRELEASEFILENAME=MyPortableRelease.zip release</pre> +<pre class="cmd"><span class="prompt">></span> Make -DPORTABLE -DRELEASEFILENAME=MyPortableRelease release</pre> + +<p> + Once again note that the <code>.zip</code> extension should not be included in the file name. +</p> <p class="note"> <strong>Warning:</strong> If you are building both the standard and portable @@ -756,6 +809,35 @@ <h4> built release will overwrite the first. </p> +<h4> + Including version numbers in zip file names +</h4> + +<p> + A version number can be suffixed to the release zip file name by defining the <code>VERSION</code> macro. + This macro works with both the <code>PORTABLE</code> and <code>RELEASEFILENAME</code> macros. +</p> + +<p> + For example to appended version number 4.22.0 to the zip file name on a standard edition build, with the default + file name do: +</p> + +<pre class="cmd"><span class="prompt">></span> Make -DVERSION=4.22.0 release</pre> + +<p> + This will create a zip file named <code>codesnip-exe-4.22.0.zip</code>. +</p> + +<p> + A more complex example would be to append the same version number to a portable edition build named <code>MyPortableRelease</code>. Do: +</p> + +<pre class="cmd"><span class="prompt">></span> Make -DPORTABLE -DRELEASEFILENAME=MyPortableRelease -DVERSION=4.22.0 release</pre> + +<p> + This time the resulting zip file will be named <code>MyPortableRelease-4.22.0.zip</code>. +</p> <h3> Build and Release Everything @@ -777,16 +859,42 @@ <h3> <span class="prompt">></span> Make setup <span class="prompt">></span> Make release</pre> -<h4> - Portable edition -</h4> - <p> To perform a complete build of the portable edition of <em>CodeSnip</em> do </p> <pre class="cmd"><span class="prompt">></span> Make -DPORTABLE</pre> +<p> + Note that the <code>RELEASEFILENAME</code> and <code>VERSION</code> macros that can be used for customising + zip file names can be used here too. +</p> + +<p> + There is also a quicker way to build a release, but you must provide a version number to use it. First navigate up + to the repository root. Then run +</p> + +<pre class="cmd"><span class="prompt">></span> Deploy 9.9.9</pre> + +<p> + where <code>9.9.9</code> is the release version number. +</p> + +<p> + This command will build both the standard and portable executables, the help file, the standard edition setup file + and finally create the release zip files for both editions, with the release version number incorporated in the file names. +</p> + +<p> + Using <code>Deploy 9.9.9</code> is the equivalent of doing: +</p> + +<pre class="cmd"><span class="prompt">></span> cd Src +<span class="prompt">></span> Make -DVERSION=9.9.9 +<span class="prompt">></span> Make -DPORTABLE -DVERSION=9.9.9 +<span class="prompt">></span> cd ..</pre> + <h3> Clean Up </h3> @@ -813,14 +921,14 @@ <h2> </p> <p> - To compile the tests, open the <code>.\Src\CodeSnip.groupproj</code> group + To compile the tests, open the <code>Src\CodeSnip.groupproj</code> group project file in the Delphi XE IDE. Now select the <em>CodeSnipTests.exe</em> target in the project manager and compile. </p> <p> If they were not already present <code>Bin</code> and <code>Exe</code> - sub-directories will have been created in the <code>.\Tests</code> directory. + sub-directories will have been created in the <code>Tests</code> directory. The <code>Exe</code> directory contains the <em>DUnit</em> test program while <code>Bin</code> contains intermediate binaries. </p> @@ -828,7 +936,7 @@ <h2> <p> You can compile the tests as either a GUI application (default) or as a console application. For details please see the comments in - <code>.\Tests\Src\DUnit\CodeSnipTests.dpr</code>. + <code>Tests\Src\DUnit\CodeSnipTests.dpr</code>. </p> <h2> @@ -845,6 +953,67 @@ <h2> directory. </p> +<h2 id="conditions"> + Conditions For Release of Modified Code +</h2> + +<p> + If you are intending to release your own application based on the <em>CodeSnip</em> source code you <strong>must</strong> <em>either</em> change the source code as described below <em>or</em> seek written permission to use the DelphiDabbler CodeSnip branding. To seek such permission please use the <em>CodeSnip</em> <a href="https://github.com/delphidabbler/codesnip/issues">Issue Tracker</a> on GitHub. +</p> + +<h3> + Required Changes +</h3> + +<p> + The changes are required to remove DelphiDabbler CodeSnip copyrighted branding from the program, to prevent interference with existing CodeSnip installations and to remove any implied endorsement of the modified release. You <strong>must</strong>: +</p> + +<ol> + <li> + <p> + Replace the files in the <code>Src\Res\Img\Branding</code> directory with copies of the identically named placeholder files in the <code>Src\Res\Img\AltBranding</code> directory. The placeholder files are Public Domain, so you may use them as-is, edit them or replace them. If you delete the files in <code>Src\Res\Img\Branding</code> without copying the placeholder files across then <em>CodeSnip</em> will fail to build. + </p> + </li> + <li> + <p> + Replace all relevant references, in source code and documentation, to the names "CodeSnip" and "DelphiDabbler" with your own company and program name. Relevant occurences are: + </p> + <ul> + <li> + Wherever the names may be displayed in the GUI. + </li> + <li> + Wherever the names may be displayed by the installer. + </li> + <li> + Wherever the names occur in directory names. In particular do not use the names in the program's <code>%ProgramData%</code> and <code>%AppData%</code> sub-directories. + </li> + <li> + Anywhere else that use of the names could imply endorsement of the modified code. + </li> + </ul> + </li> + <li> + <p> + Provide your own license file with content compatible with the requirements of the <em>CodeSnip</em> license as it relates to the code reused from the <em>CodeSnip</em> source tree. <strong>Do not</strong> edit or re-use <code>Docs/License.html</code>. + </p> + </li> + <li> + <p> + Modify source code and documentation where necessary to acknowledge the origins of the program's source code, documentation and images, in accordance with the <em>CodeSnip</em> license. + </p> + </li> +</ol> + +<p> + Note that the <em>CodeSnip</em> license can be found in <code>Docs\License.html</code>. +</p> + +<p> + If you are unsure about whether your changes meet the license requirements then you can seek clarification by creating an issue on the aforementioned <a href="https://github.com/delphidabbler/codesnip/issues">Issue Tracker</a>. +</p> + </body> </html> diff --git a/CHANGELOG.md b/CHANGELOG.md index acb677949..716973f89 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,473 +1,664 @@ # Changelog +This is the change log for _DelphiDabbler CodeSnip_. It begins with the first ever pre-release version of _CodeSnip_. -This is the change log for _DelphiDabbler CodeSnip_. - -All notable changes to this project are documented in this file. - -This change log begins with the first ever pre-release version of _CodeSnip_. Releases are listed in reverse version number order. +Releases are listed in reverse version number order. > Note that _CodeSnip_ v4 was developed in parallel with v3 for a while. As a consequence some v3 releases have later release dates than early v4 releases. -From v4.1.0 the version numbering has attempted to adhere to the principles of [Semantic Versioning](https://semver.org/spec/v2.0.0.html). - +## Release v4.27.0 of 12 September 2025 + +* Added support for test compiling snippets with Delphi 13 Florence [issue #170]. +* Documentation changes re addition of support for Delphi 13: + * File format additions for config file, export files, user database and main database. + * `Docs/ReadMe-portable.txt` & `Docs/ReadMe-standard.txt` + * Relevant help topics. + +## Release v4.26.0 of 02 May 2025 + +* Updated the dialogue box displayed when saving units and annotated source code [issue #166]: + * The _File Encoding_ drop down list control is disabled if there is only one encoding option. + * Updated and clarified the naming of encodings in the _File Encoding_ drop down list. + * The sole encoding option displayed for the _Rich text file_ file type was changed from the erroneous ANSI to the correct ASCII. +* Fixed bug where, when ANSI encoding was selected in the _Save Unit_ and _Save Annotated Source_ dialogue boxes, snippets containing characters not supported in the default locale's code page were being rendered diffently in the Preview dialogue box to when saved to file [issue #164]. The previewed code is now the same as that of the saved source code. +* Updated file formats available when the _File | Save Snippet Information_ menu option is selected: + * Syntax highlighting of the existing RTF format output is now optional. + * Added the option to save snippet information in the following new formats: + * Plain text, in UTF-8, UTF-16LE, UTF-16BE and the system locale's default ANSI code page. [issue #162] + * HMTL 5 with optional syntax highlighting, in UTF-8 format [issue #153]. + * XHTML with optional syntax highlighting, in UTF-8 format [issue #153]. + * Markdown, in UTF-8, UTF-16LE, UTF-16BE and the system locale's default ANSI code page [issue #155]. + * Changed the _Save Snippet Information_ dialogue box: + * It is now based on that used for saving unit and annotated source code in that file encoding and snippet highlighting can be customised where relevant, although the _Comment style_ controls are disabled since they are not relevant. + * The suggested file name was changed from "SnippetInfo" to the display name of the selected snippet. + * The dialogue box caption now contains the display name of the selected snippet. +* Changed the title of the _Save Annotated Source_ dialogue box when displaying snippets. +* Added option to prevent descriptive comments from appearing in the implementation section of generated units. A check box for this option has been added to the _Code Formatting_ tab of the _Preferences_ dialogue box [issue #85]. +* The _Help | CodeSnip News Blog_ menu item was changed to link to the [DelphiDabbler Blog](https://delphidabbler.blogspot.com/) instead of the CodeSnip Blog, because the latter is to be closed down. The menu item was renamed to _Help | CodeSnip News On DelphiDabbler Blog_ [issue #161]. +* Improved how the CSS used in generated HTML 5 and XHTML files is generated: + * The ordering of CSS selectors can now be pre-determined. + * CSS lengths and sizes can now be specified in units, such as `em`, instead of just pixels. +* Refactored the `USourceGen` unit to remove an unnecessary dependency on user preferences [issue #167]. +* Updated the help file: + * Re changes when saving snippet information [issue #163]. + * Re changes to the _Save Unit_ and _Save Annotated Source_ dialogue boxes. + * Re changes to the blog linked from the _Help_ menu. + * Re the new option to inhibit comments in the implementation sections of generated units. +* Updated documentation: + * File format documentation was changed re the addition of the Markdown file format and the changes to the encodings used in saved files. + * Read-me files were updated re the change of news blog. + +## Release v4.25.0 of 19 April 2025 + +* Added new feature to save snippet information to file in RTF format using the new _File | Save Snippet Information_ menu option [issue #140]. +* Added the option to save optionally highlighted annotated source code and units in HTML 5 format [issue #87]. +* Fixed malformed bullet character(s) in the list of imported snippets on the last page of the Snippets Import Wizard dialogue box [issue #147]. +* Improved the solution to the crash after hibernation bug, initially fixed in v4.24.1 and v4.24.2, with much improved and more stable code [issue #158]. Implemented by [@SirRufo](https://github.com/SirRufo). +* Overhauled rich text format processing: + * Fixed bug where Unicode characters that don't exist in the system code page were not being displayed correctly [issue #157]. + * Fixed potential bug where some reserved ASCII characters may not be escaped properly [issue #159]. + * Refactored and improved the rich text handling code [issue #100]. +* Corrected the copyright date displayed in the About Box to include 2025 [issue #149]. +* Documentation changes: + * Fixed error in the export file formation documentation and related help topic [issue #151]. + * Corrected erroneous comments for the _TREMLEntities.MapToEntity_ method [issue #84]. + * Updated file format documentation with details the changes introduced when implementing issues #87 and #140. + * Updated the help file with details of the new features added in this release. + +## Release v4.24.2 of 14 April 2025 + +Hotfix release. + +* Updated bug fix implemented in v4.24.1 to avoid relying on a potentially problematic windows event [issue #70 (2nd attempt)]. +* Corrected release date error for v4.24.1 in `CHANGELOG.md`. + +## Release v4.24.1 of 13 April 2025 + +* Fixed bug where CodeSnip occasionally crashes after a computer resumes from hibernation [issue #70]. +* Updated license copyright dates for 2025. + +## Release v4.24.0 of 23 October 2024 + +* Compilers with which a snippet has not been tested are now omitted from snippet information that is copied to the clipboard and included in print outs [issue #143]. +* Reversed order of compilers in the snippets editor's _Compile Results_ tab so that later compilers are display first. This change was accidentally left out of release v4.22.0 when similar changes were made in other parts of the UI [issue #135]. +* Release version number is now displayed in the program title bar [issue #122]. +* Fixed incorrect copyright date displayed in About Box [issue #129]. +* Fixed bug when checking for correct preamble bytes (BOMs) in UTF-8 and UTF-16 format text files [issue #139]. +* Portable and Standard edition now use the same program names. Portable edition was previously declaring itself as _DelphiDabbler CodeSnip-p_ instead of _DelphiDabbler CodeSnip_ [issue #130]. +* Updated operating system detection code [issues #126 and #144]. +* Added `Deploy.bat` script to create and package both the CodeSnip standard and portable releases [issue #128]. +* Documentation changes: + * CodeSnip standard and portable releases now each have their own release read-me files instead of both releases being shipped with the same read-me [issue #127]. Updated `Build.html` and `README.md` re this change. + * Updated and corrected REML documentation and REML help topic. Those documents and others that discuss REML were also changed to link to authoritative REML definitions in the `delphidabbler/reml` repository. [issues #131, #133 & #134]. + * Updated `Build.html` with alternative, more secure, download link for `zip.exe` program that is required to package releases [issue #137]. + +## Release v4.23.0 of 02 April 2024 + +* Removed marketing names (e.g. "Athens" or "Rio") from Delphi compiler names to save space when the compiler names are displayed in the UI [issue #125]. +* Added new `'` entity to REML markup language and boosted REML version to v6 as a consequence [issue #99]. +* Refactored class helper code by splitting a single monolithic unit into three more specialised units [issue #90]. +* Updated documentation and related help topic re change to REML v6. + +## Release v4.22.0 of 08 November 2023 + +* Added support for test compiling snippets with Delphi 12 Athens [issue #121]. +* Documentation changes re addition of support for Delphi 12: + * File format additions for config, export, user database and main database. + * `Docs/ReadMe.txt`. + * Relevant help topics. +* Reversed order in which compilers are listed in the Configure Compilers and Find Compilers dialogue boxes so that the most recent version of Delphi is listed first [issue #51]. +* Refactored out all `with` statements from Pascal source code [issue #118]. +* Fixed error in `CHANGELOG.md` entry for release v4.21.2 [issue #120]. + +## Release v4.21.2 of 14 July 2023 + +* Removed broken links and fixed unsafe links in the About box [issue #105]. +* Fixed bug in version information files that resulted in an error in the Comments section of the version information of both editions of _CodeSnip_ [issue #106]. +* Fixed potential XSS vulnerability in JQuery code used in Easter egg [issue #107]. +* Documentation changes: + * Rationalised, corrected, updated and clarified licensing information. These changes affected many documentation files. [issue #108]. + * Overhauled `README.md` and `Docs/ReadMe.txt` and created a new `CONTRIBUTING.md` file that explains how to contribute in detail [issue #104]. + +## Release v4.21.1 of 09 April 2023 + +* Completed implementation of support for [REML version 5](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/version-4.21.0/Docs/Design/reml.html) (omitted from v4.21.0 in error) and fixed some bugs in the original implementation [issues #81 and #82], including: + * Heavily revised "active text" handling code and document model to fix support for lists introduced in v4.21.0. + * Added support for rendering lists in plain text reports and generated source code header comments. + * Added support for rendering lists in Rich Text Format for use in printed information and in reports copied to the clipboard. + * Overhauled HTML rendering code that generates HTML for display in the UI. + * Heavily revised parsing and generation of REML code. + * Updated "active text" validation code. +* Prevented snippets editor from stripping REML `<p>` tags [issue #103]. +* Fixed garbled copyright symbols in generated source code [issue #80]. +* Fixed bug in code that compresses multiple white space into a single space [issue #95]. +* Fixed out of range error in code that handles text encodings [issue #97]. +* Fixed broken formatting of compiler result tables in text and rich text snippet reports & print outs [issue #101]. +* Updated copyright date displayed in about box [issue #98]. +* Updated operating system detection code to detect Windows 10/11 builds released in December 2022 and Q1 2023. +* Some refactoring [including issue #83] +* Changed build process to create all files in `_build` directory and to use different zip file names [issue #78]. +* Documentation changes: + * Updated `Build.html` to document changes in build process. + * Updated `CHANGELOG.md` to fix broken link [issue #76] and to remove information about semantic versioning. + * Removed broken links in `Docs/License.html`. + * Updated copyright date in various license files [including issue #96]. + * Fixed errors and oversights in REML documentation. +* Removed some redundant tests that were failing due to passing invalid parameters to the revised _StrWrap_ routine [issue #79]. + +## Release v4.21.0 of 16 December 2022 + +* Updated to support [REML version 5](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/version-4.21.0/Docs/Design/reml.html) in snippet description & extra information [issue #71]: + * Numerous new character entities supported. + * New list tags: `<ol>`, `<ul>` & `<li>`. +* Program now automatically detects new (supported) Delphi installations at startup and offers to register the compiler(s) to be used for test compiling snippets. This feature is on by default but can be turned off completely or for specifically excluded compilers [issue #19]. +* Modified Configure Compilers dialogue box: + * Added facility to customise automatic compiler detection on per-compiler or global basis. + * Changed manually triggered compiler detection to ignore excluded compilers. +* Some refactoring [including issues #73 and #75]. +* Minor changes to program license + * Changed required image attribution in `Docs/License.html` [issue #63] + * Corrected copyright date & fix typo in licenses displayed by installer and help file [issue #65 & PR #72]. +* Bump per-user config file to version 19. +* Documentation updates: + * Updated `README.md` re abandoned and new Git repo branches. + * Updated config file, database, export file & REML documentation re changes in this release [including issue #74]. + * Help file updated with details of changes in this release. + * Updated development tool chain requirements in `Build.html`. + +## Release v4.20.2 of 04 November 2022 + +* Fixes bug where an exception was raised when selecting a main menu item with the cursor keys then pressing F1. [issue 54] +* Update operating system detection code to correctly detect Version 22H2 of Windows 10 & Windows 11 plus some other Windows releases on the Dev, Beta & Release channels. [issues 55, 61 & 62] +* Fix appearance of copyright symbol in version information. + +## Release v4.20.1 of 01 July 2022 + +* Operating system detection code was updated to (a) fix bugs and (b) detect some Dev, Beta and Release Preview builds of Windows 11 22H2. +* Fixed copyright date in `Docs/License.html`. + +## Release v4.20.0 of 15 May 2022 + +* Added an option to delete the user defined database. +* Fixed bug that enabled the user to attempt to move, or back up, the user database when it doesn't exist. These options are now disabled when there is no user database. +* Added facility to customise the size of font used in the details pane for all items except the source code font (which could already be modified separately). A new preference was added to the Display pane of the Preferences dialogue box to be used to set the font size. +* Rearranged the controls on the Preferences dialogue box's Display pane. +* Changed the default font used for the overview pane from a fixed value to the default size for the underlying operating system. +* Changed the description of "Delphi 11 Alexandria" to "Delphi 11.x Alexandria" to reflect the fact the Delphi 11 updates have different minor version numbers, but can't be installed alongside each other. +* Widened the compiler list box in the Configure Compilers dialogue box to accommodate the longer name used for Delphi 11.x compilers. +* Refactored some font handling code. +* Operating system detection code was updated to (a) fix some bugs and (b) detect some Dev channel builds of Windows 11. +* Bumped the version of the per-user config file to 18 following the addition of a new preference. +* Help file updated re the changes in this release. +* Documentation updated to reflect changes in this release. +* Updated `README.md` and `Build.html` + +## Release v4.19.0 of 31 December 2021 + +* Improved user-friendliness of Preferences dialogue box: + * Removed multi-line tab sets and replacing navigation pane on left hand side of window. + * Hid warning on Printing preferences page that changes will not be made until after program is restarted, if and only if page is displayed from Print dialogue box. + * Last preferences page displayed is now remembered and restored the next time the dialogue box is displayed. +* Added facility to customise size of font used in Overview pane's tree view. A new preference added to Display pane of Preferences dialogue box is used to set the font size. +* Fixed obscure bug in code that reads legacy ANSI Code Snippets Database files that was potentially using the incorrect ANSI code page. +* Updated help file re changes +* Fixed errors in custom installer dialogue boxes. +* Documentation corrected, expanded and updated, with some file format documentation having a major overhaul. +* Some tidying up: + * Fixed some broken web links in source code comments and elsewhere. + * Replaced `http` protocol in URLS with `https` wherever supported - mainly in source code comments & documentation. + * Removed some orphaned files long since removed from project. + * Added missing header comments to source file. + * Updated copyright dates in files modified during year to include 2021. + * Change log was overhauled to fix linting errors. +* Bumped version of per-user config file to 17 following addition of new preferences. +* Small amount of refactoring + +## Release v4.18.1 of 29 November 2021 + +* Improved handling of control and whitespace characters in generated HTML: revised which characters were converted to HTML character attributes / entities. +* Fixed error in title of _Save Annotated Source_ dialogue box. +* Replaced use 3rd party `GIFImage` unit with similar `GIFImg` unit from Delphi XE VCL. +* Corrected help topic for _Dependencies_ dialogue box to describe _Save & Close_ button. +* Operating system detection code was updated to correctly detect Windows 11 and Windows 10 version 21H2. +* Some refactoring. +* Updated license document (`License.html`) following removal of dependency on GIFImage unit. + +## Release v4.18.0 of 13 September 2021 + +* Added support for test compilation with, and detection of, Delphi 11 Alexandria. +* Updated various dialogue boxes to widen lists of compilers to accommodate length of new compiler name. +* Operating system detection code was updated to correctly detect Windows 10 version 20H2. +* Updated documentation re changes. +* Updated help file re changes. +* Minor documentation corrections. + +## Release v4.17.2 of 12 September 2020 + +Hotfix release. + +* Updated version of jQuery used by program easter egg from v1.8.0 to v1.12.4 to fix a known vulnerability in v1.8.0. Also updated jQuery Cycle Lite that depends on jQuery from v1.6 to 1.7. + +## Release v4.17.1 of 31 July 2020 + +Hotfix release. + +* Corrected "What's New" dialogue box content that is displayed _only_ when updating from v4.15.1 and earlier. The correction is to ensure the text makes sense when release 4.16.0 has been skipped. This change should have been made in v4.17.0. +* Removed a redundant resource. ## Release v4.17.0 of 31 July 2020 -+ Added support for test compilation with, and detection of, Delphi 10.2 Tokyo, Delphi 10.3 Rio and Delphi 10.4 Sydney compilers. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for test compilation with, and detection of, Delphi 10.2 Tokyo, Delphi 10.3 Rio and Delphi 10.4 Sydney compilers. +* Updated documentation re changes. +* Updated help file re changes. ## Release v4.16.0 of 31 May 2020 This is a significant update. It's purpose is to remove CodeSnip's dependencies on the delphidabbler.com website and associated web services. This was done because of the expected June 2020 closure or reduced functionality of delphidabbler.com. Some affected features were removed and others replaced with alternatives. -+ Removed all dependencies on web services. The following changes were made as a consequence of this: - - Replaced the option to update the main DelphiDabbler Code Snippets database from the web with an option to update it from locally stored data: - - Replaced the _Update from Web_ dialogue box with a new wizard. Menu options on the _Snippets_ menu were renamed accordingly and the old tool bar button was removed. - - Changed the database update code to use data that has been manually downloaded from the `delphidabbler/code-snippets` GitHub project. - - Modified the database reading code to accept both the new Code Snippets database v2 format _and_ the legacy v1 format. - + Replaced the option to import SWAG snippets from an on-line REST service with an option to import snippets from locally stored data. - - Revised the SWAG import wizard re the changes to the import method. - - Modified the SWAG import code to use data that has been manually downloaded from the `delphidabbler/swag` GitHub project. - - The option to register the program was removed. No registration key is now generated or stored. - - Replaced the option to read and display the CodeSnip RSS news feed with one to display the CodeSnip Blog. - - Removed the menu option used to check for program updates. - - Removed the background task that automatically checked for program and database updates. - - Removed the option to submit snippets for addition to the DelphiDabbler Code Snippets database. - - Removed support for a proxy web server - now unnecessary. - - Removed support for the `--test-server` command line option that enabled use of a different server to test web services. - - Updated install program so it no longer displays a page stating that CodeSnip will go automatically go on-line to check for updates. -+ Removed references and links to delphidabbler.com from the program, the installer, the help file and documentation. Some references were deleted while others were replaced with alternatives, including: - - Changed the URL of the FAQs to refer to the `codesnip-faq` GitHub project. - - References to swag.delphidabbler.com were replaced with references to the `delphidabbler/swag` project on GitHub. - - URLs that were redirected via a service on delphidabbler.com were replaced by hard coded URLs. -+ The export file format was changed to exclude personal user information. The original format can still be read but any user information is ignored and discarded. -+ Config file processing changes: - - Removed support for reading or writing data relating to removed features. - - When CodeSnip is first run after updating from an earlier version, any pre-existing config files are purged of any information that is no longer relevant. - - The common config file is no longer used by the portable edition. Any pre-existing file is deleted the first time the portable edition is run. - - The common and per-user config file versions were bumped to 7 and 16 respectively. -+ Welcome page changes: - - Removed the _Update Checks_ and _Donate_ sections and related links. - - Removed links used to check for program and database updates. - - Replaced the link used to display the news feed with one that displays the CodeSnip blog. -+ Added a "What's New" type of dialogue box that can be selectively displayed when a new version of CodeSnip is run for the first time. v4.16.0 _always_ displays the dialogue box when first run. -+ The operating system detection code was updated to correctly detect all Windows and Windows Server releases as of March 2020. -+ Revised the _About_ dialogue box: - - To display version and licensing information extracted from Code Snippets Database v2 meta data. - - To remove credits for 3rd party code that is no longer used. -+ The bug tracker dialogue boxes were updated re the change of issue tracker from SourceForge to GitHub. -+ Removed redundant pages and controls from the _Preferences_ dialogue box. -+ Removed the _Donate_ dialogue box and associated menu options. -+ Revised and re-ordered some menu options. -+ The program no longer generates and saves an application identifier key. -+ Bugs fixed: - - Corrected license information stored in the _Extra_ information section of imported SWAG packages. - - Fixed a text formatting error in the SWAG import wizard ([issue #4](https://github.com/delphidabbler/codesnip/issues/4)). - - Fixed broken help topic links in some dialogue boxes ([issue #3](https://github.com/delphidabbler/codesnip/issues/3)) - - Fixed a bug in the portable edition's startup processing of its config file. - - Fixed the dialogue box displayed when updating from CodeSnip v3 or earlier to display an icon in the Windows task bar. - - Corrected the license details included in comments of generated source code that includes snippets from the main database. - - Corrected typos and errors in the UI. -+ Some source code refactoring and clarifications. -+ Removed redundant library code: - - Encryption library. - - Indy Internet components. -+ Help file overhauled: new topics added, redundant topics removed and many errors corrected. Some restyling. -+ Updated documentation, including: - - Major changes to `./README.md` and `./Docs/ReadMe.txt`. - - Merged all the major version specific changelogs into a single `./CHANGELOG.md` file and deleted the old files. - - File format documentation was overhauled re changes introduced in this release. - - Edited `./Docs/License.html` to remove license information and acknowledgements for 3rd party code that is no longer used. - - Fixed errors in `./Build.html` concerning the source code repository and made some other minor changes. - - Removed the privacy statement document, `./Docs/Privacy.txt` since CodeSnip no longer stores or transmits any personal information. (Also removed privacy help topic and menu item.) - - Removed `./Docs/Design/WebServices.txt` file that described the web services used by CodeSnip. - +* Removed all dependencies on web services. The following changes were made as a consequence of this: + * Replaced the option to update the main DelphiDabbler Code Snippets database from the web with an option to update it from locally stored data: + * Replaced the _Update from Web_ dialogue box with a new wizard. Menu options on the _Snippets_ menu were renamed accordingly and the old tool bar button was removed. + * Changed the database update code to use data that has been manually downloaded from the `delphidabbler/code-snippets` GitHub project. + * Modified the database reading code to accept both the new Code Snippets database v2 format _and_ the legacy v1 format. + * Replaced the option to import SWAG snippets from an on-line REST service with an option to import snippets from locally stored data. + * Revised the SWAG import wizard re the changes to the import method. + * Modified the SWAG import code to use data that has been manually downloaded from the `delphidabbler/swag` GitHub project. + * The option to register the program was removed. No registration key is now generated or stored. + * Replaced the option to read and display the CodeSnip RSS news feed with one to display the CodeSnip Blog. + * Removed the menu option used to check for program updates. + * Removed the background task that automatically checked for program and database updates. + * Removed the option to submit snippets for addition to the DelphiDabbler Code Snippets database. + * Removed support for a proxy web server - now unnecessary. + * Removed support for the `--test-server` command line option that enabled use of a different server to test web services. + * Updated install program so it no longer displays a page stating that CodeSnip will go automatically go on-line to check for updates. +* Removed references and links to delphidabbler.com from the program, the installer, the help file and documentation. Some references were deleted while others were replaced with alternatives, including: + * Changed the URL of the FAQs to refer to the `codesnip-faq` GitHub project. + * References to swag.delphidabbler.com were replaced with references to the `delphidabbler/swag` project on GitHub. + * URLs that were redirected via a service on delphidabbler.com were replaced by hard coded URLs. +* The export file format was changed to exclude personal user information. The original format can still be read but any user information is ignored and discarded. +* Config file processing changes: + * Removed support for reading or writing data relating to removed features. + * When CodeSnip is first run after updating from an earlier version, any pre-existing config files are purged of any information that is no longer relevant. + * The common config file is no longer used by the portable edition. Any pre-existing file is deleted the first time the portable edition is run. + * The common and per-user config file versions were bumped to 7 and 16 respectively. +* Welcome page changes: + * Removed the _Update Checks_ and _Donate_ sections and related links. + * Removed links used to check for program and database updates. + * Replaced the link used to display the news feed with one that displays the CodeSnip blog. +* Added a "What's New" type of dialogue box that can be selectively displayed when a new version of CodeSnip is run for the first time. v4.16.0 _always_ displays the dialogue box when first run. +* The operating system detection code was updated to correctly detect all Windows and Windows Server releases as of March 2020. +* Revised the _About_ dialogue box: + * To display version and licensing information extracted from Code Snippets Database v2 meta data. + * To remove credits for 3rd party code that is no longer used. +* The bug tracker dialogue boxes were updated re the change of issue tracker from SourceForge to GitHub. +* Removed redundant pages and controls from the _Preferences_ dialogue box. +* Removed the _Donate_ dialogue box and associated menu options. +* Revised and re-ordered some menu options. +* The program no longer generates and saves an application identifier key. +* Bugs fixed: + * Corrected license information stored in the _Extra_ information section of imported SWAG packages. + * Fixed a text formatting error in the SWAG import wizard ([issue #4](https://github.com/delphidabbler/codesnip/issues/4)). + * Fixed broken help topic links in some dialogue boxes ([issue #3](https://github.com/delphidabbler/codesnip/issues/3)) + * Fixed a bug in the portable edition's startup processing of its config file. + * Fixed the dialogue box displayed when updating from CodeSnip v3 or earlier to display an icon in the Windows task bar. + * Corrected the license details included in comments of generated source code that includes snippets from the main database. + * Corrected typos and errors in the UI. +* Some source code refactoring and clarifications. +* Removed redundant library code: + * Encryption library. + * Indy Internet components. +* Help file overhauled: new topics added, redundant topics removed and many errors corrected. Some restyling. +* Updated documentation, including: + * Major changes to `./README.md` and `./Docs/ReadMe.txt`. + * Merged all the major version specific changelogs into a single `./CHANGELOG.md` file and deleted the old files. + * File format documentation was overhauled re changes introduced in this release. + * Edited `./Docs/License.html` to remove license information and acknowledgements for 3rd party code that is no longer used. + * Fixed errors in `./Build.html` concerning the source code repository and made some other minor changes. + * Removed the privacy statement document, `./Docs/Privacy.txt` since CodeSnip no longer stores or transmits any personal information. (Also removed privacy help topic and menu item.) + * Removed `./Docs/Design/WebServices.txt` file that described the web services used by CodeSnip. ## Release v4.15.1 of 22 September 2016 -+ Updated OS detection code to detect Windows 10 Version 1607 (Anniversary update) and all technical previews of Windows 2016 Server to date. - +* Updated OS detection code to detect Windows 10 Version 1607 (Anniversary update) and all technical previews of Windows 2016 Server to date. ## Release v4.15.0 of 13 July 2016 -+ Added support for test compilation with, and detection of, Delphi 10.1 Berlin compiler. -+ Tweaked size of compiler list in Configure Compilers dialogue box to accommodate length of Delphi 10.1 Berline compiler name! -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for test compilation with, and detection of, Delphi 10.1 Berlin compiler. +* Tweaked size of compiler list in Configure Compilers dialogue box to accommodate length of Delphi 10.1 Berline compiler name! +* Updated documentation re changes. +* Updated help file re changes. ## Release v4.14.0 of 19 March 2016 -+ Changes to About Box's "Paths" tab: - - Added new buttons to display the contents of the system and per-user config files. - - Renamed tab as "Paths & Files". -+ Implemented feature request #83 ~~(https://sourceforge.net/p/codesnip/feature-requests/83/)~~ to enable the name and port of any web service test server to be passed on command line by using the new "--test-server" command line option. This replaces hard-wired test server name & port that was activated using the now removed "-localhost" command line switch. -+ Fixed bug #96: "Some open / save dialogues too small" ~~(https://sourceforge.net/p/codesnip/bugs/96/)~~. The height of customised dialogue boxes was increased. -+ Updated operating system detection code to detect Windows 10 TH2. -+ New photo of Sophie the dog added to the Easter egg slide show! -+ Updated help file re About Box changes. - +* Changes to About Box's "Paths" tab: + * Added new buttons to display the contents of the system and per-user config files. + * Renamed tab as "Paths & Files". +* Implemented [SourceForge] feature request #83 to enable the name and port of any web service test server to be passed on command line by using the new "--test-server" command line option. This replaces hard-wired test server name & port that was activated using the now removed "-localhost" command line switch. +* Fixed [SourceForge] bug #96: "Some open / save dialogues too small". The height of customised dialogue boxes was increased. +* Updated operating system detection code to detect Windows 10 TH2. +* New photo of Sophie the dog added to the Easter egg slide show! +* Updated help file re About Box changes. ## Release v4.13.2 of 20 February 2016 -+ Updated and corrected hints displayed in main window. -+ Changed some menu options and associated dialogue box captions. -+ Tweaked some button captions in Select Snippets dialogue box. -+ Updated help file re the menu and caption changes. -+ Updated copyright date in program license as displayed in help, about box, installer and documentation. - +* Updated and corrected hints displayed in main window. +* Changed some menu options and associated dialogue box captions. +* Tweaked some button captions in Select Snippets dialogue box. +* Updated help file re the menu and caption changes. +* Updated copyright date in program license as displayed in help, about box, installer and documentation. ## Release v4.13.1 of 29 September 2015 -+ Improved operating system detection to detect Windows 10. -+ Modified program's manifest to declare it compatible with Windows 8 to 10. -+ Code that determines which system font to use no longer depends on OS version but simply on font availability. -+ Updated copyright date in program license as displayed in help, about box, installer and documentation. - +* Improved operating system detection to detect Windows 10. +* Modified program's manifest to declare it compatible with Windows 8 to 10. +* Code that determines which system font to use no longer depends on OS version but simply on font availability. +* Updated copyright date in program license as displayed in help, about box, installer and documentation. ## Release v4.13.0 of 5 September 2015 -+ Added support for test compilation with, and detection of, Delphi 10 Seattle compiler. -+ Made some minor changes to method used to build required type library to remove dependency on the MS MIDL compiler, greatly simplifying build process. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for test compilation with, and detection of, Delphi 10 Seattle compiler. +* Made some minor changes to method used to build required type library to remove dependency on the MS MIDL compiler, greatly simplifying build process. +* Updated documentation re changes. +* Updated help file re changes. ## Release v4.12.0 of 6 May 2015 -+ Added support for test compilation with, and detection of, Delphi XE8 compiler. -+ Updated documentation re changes. -+ Updated help file re changes and fixed some spelling mistakes. - +* Added support for test compilation with, and detection of, Delphi XE8 compiler. +* Updated documentation re changes. +* Updated help file re changes and fixed some spelling mistakes. ## Release v4.11.1 of 26 October 2014 -+ Corrected an erroneous error message that is displayed when circular snippet references are detected in the snippets editor (no bug report filed). -+ Corrected some spelling errors in UI. -+ Some documentation corrections. - +* Corrected an erroneous error message that is displayed when circular snippet references are detected in the snippets editor (no bug report filed). +* Corrected some spelling errors in UI. +* Some documentation corrections. ## Release v4.11.0 of 25 September 2014 -+ Changes re licensing of snippets from online Code Snippets Database under MIT license: - - Generated code now carries a reference to the MIT license where relevant. - - Submit Snippets wizard has a new page where user must confirm that any submitted snippets may be MIT licensed. - - "About the Database" of the About Box now refers to the license. - - Documentation and help file updated accordingly. -+ Now uses version 6 of the Code Snippets Database update web service which supports the downloading of category and source code files larger than 32Kb. -+ The undocumented -localhost command line option now causes CodeSnip to expect web services to be on localhost port 8080 instead of port 80. This change has no effect on normal operation and is used only in testing. -+ Minor layout tweaks in in Display tab of Preferences dialogue box. -+ Minor changes to help file and documentation. - +* Changes re licensing of snippets from online Code Snippets Database under MIT license: + * Generated code now carries a reference to the MIT license where relevant. + * Submit Snippets wizard has a new page where user must confirm that any submitted snippets may be MIT licensed. + * "About the Database" of the About Box now refers to the license. + * Documentation and help file updated accordingly. +* Now uses version 6 of the Code Snippets Database update web service which supports the downloading of category and source code files larger than 32Kb. +* The undocumented -localhost command line option now causes CodeSnip to expect web services to be on localhost port 8080 instead of port 80. This change has no effect on normal operation and is used only in testing. +* Minor layout tweaks in in Display tab of Preferences dialogue box. +* Minor changes to help file and documentation. ## Release v4.10.0 of 12 September 2014 -+ Added support for test compilation with, and detection of, Delphi XE7 compiler. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for test compilation with, and detection of, Delphi XE7 compiler. +* Updated documentation re changes. +* Updated help file re changes. ## Release v4.9.0 of 30 April 2014 -+ Added support for test compilation with, and detection of, Delphi XE6 compiler. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for test compilation with, and detection of, Delphi XE6 compiler. +* Updated documentation re changes. +* Updated help file re changes. ## Release v4.8.7 of 06 March 2014 -+ Fixed automatic update checker so that it correctly records last update date. This fixes bug #93 ~~(http://bit.ly/NmSQUt)~~. -+ Updated to use v2 of the DelphiDabbler CodeSnip update web service when checking for availability of program updates. -+ Minor corrections to help file. - +* Fixed automatic update checker so that it correctly records last update date. Fixes [SourceForge] bug #93. +* Updated to use v2 of the DelphiDabbler CodeSnip update web service when checking for availability of program updates. +* Minor corrections to help file. ## Release v4.8.6 of 28 February 2014 -+ Improved operating system detection to handle Windows 8.1. -+ Added compatibility section to application manifest that declares the program has been tested with Windows Vista and Windows 7. - +* Improved operating system detection to handle Windows 8.1. +* Added compatibility section to application manifest that declares the program has been tested with Windows Vista and Windows 7. ## Release v4.8.5 of 13 January 2014 -+ Fixed bug #91 "Generated units won't compile on Delphi XE5" ~~(http://bit.ly/1eBjym2)~~. Compiler directives that are used to change compiler warnings now includes a conditionally compiled $LEGACYIFEND ON directive. -+ Fixed potential bug when checking for the existence of files. It had been possible that a "sym-link" to a file could give misleading results. -+ Updated program copyright date in license file, about box, help file and installer. - +* Fixed [SourceForge] bug #91: "Generated units won't compile on Delphi XE5". Compiler directives that are used to change compiler warnings now includes a conditionally compiled $LEGACYIFEND ON directive. +* Fixed potential bug when checking for the existence of files. It had been possible that a "sym-link" to a file could give misleading results. +* Updated program copyright date in license file, about box, help file and installer. ## Release v4.8.4 of 28 November 2013 -+ Improved user interface of SWAG Import Wizard. -+ Renamed "Save Snippet" and "Copy Snippet" menu options to "Save Annotated Source" and "Copy Annotated Source". This fixes bug #90: " Wrong caption on menu option for copying category to clipboard" ~~(http://bit.ly/ImA398)~~. -+ Revised and corrected numerous main menu and pop-up menu hints. -+ Updated help file re changes to menu options and SWAG Import Wizards. - +* Improved user interface of SWAG Import Wizard. +* Renamed "Save Snippet" and "Copy Snippet" menu options to "Save Annotated Source" and "Copy Annotated Source". This fixes [SourceForge] bug #90: " Wrong caption on menu option for copying category to clipboard". +* Revised and corrected numerous main menu and pop-up menu hints. +* Updated help file re changes to menu options and SWAG Import Wizards. ## Release v4.8.3 of 06 November 2013 -+ Fixed registry access code so that the 64 bit view of the registry is used when CodeSnip runs on a Windows 64 bit operating system. -+ Changed to avoid use of a deprecated API call when using the Windows Browse for Folder dialogue box. -+ Updated documentation. - +* Fixed registry access code so that the 64 bit view of the registry is used when CodeSnip runs on a Windows 64 bit operating system. +* Changed to avoid use of a deprecated API call when using the Windows Browse for Folder dialogue box. +* Updated documentation. ## Release v4.8.2 of 30 October 2013 -+ Modified Syntax Highlighter tab of Preferences dialogue box so that "vertical" fonts (whose names begin with "@") no longer appear in list of available fonts. -+ Fixed potential bug in operating system detection code that may fail on Windows 2000. - +* Modified Syntax Highlighter tab of Preferences dialogue box so that "vertical" fonts (whose names begin with "@") no longer appear in list of available fonts. +* Fixed potential bug in operating system detection code that may fail on Windows 2000. ## Release v4.8.1 of 18 September 2013 -+ Removed "File | Page Setup" menu option because some settings made there were being ignored when a file was printed. This is a fix for bug #89 "Setup selections not being remembered" ~~(http://bit.ly/1a3V94x)~~. -+ Updated help file re changes. - +* Removed "File | Page Setup" menu option because some settings made there were being ignored when a file was printed. This is a fix for [SourceForge] bug #89: "Setup selections not being remembered". +* Updated help file re changes. ## Release v4.8.0 of 12 September 2013 -+ Added support for Delphi XE5 compiler. -+ Fixed bug in code that reads or imports user database files written using CodeSnip 3 where Delphi XE4 compile results would be lost. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for Delphi XE5 compiler. +* Fixed bug in code that reads or imports user database files written using CodeSnip 3 where Delphi XE4 compile results would be lost. +* Updated documentation re changes. +* Updated help file re changes. ## Release v4.7.2 of 27 August 2013 -+ Fixed bug #88 "SWAG Import Wizard display bug" ~~(http://bit.ly/15ryOxz)~~ where duplicate snippets could be displayed on the "Ready to import" page in certain circumstances. - +* Fixed [SourceForge] bug #88: "SWAG Import Wizard display bug" where duplicate snippets could be displayed on the "Ready to import" page in certain circumstances. ## Release v4.7.1 of 18 August 2013 -+ Fixed bug where right clicking a tab in the detail pane sometimes caused the contents of the pane to be temporarily blanked out while the context menu was displayed. - - This fix also, as a side effect, fixed bug #87 "Tab headings and contents don't match after a tab is closed." ~~(http://bit.ly/15TD197)~~. - +* Fixed bug where right clicking a tab in the detail pane sometimes caused the contents of the pane to be temporarily blanked out while the context menu was displayed. +* The above fix also, as a side effect, fixed [SourceForge] bug #87: "Tab headings and contents don't match after a tab is closed." ## Release v4.7.0 of 31 July 2013 -+ Implemented feature request #71 "Support importing of one or more snippets from the SWAG database" ~~(http://bit.ly/18AFlGu)~~: - - Uses DelphiDabbler SWAG web service to get SWAG data. - - New wizard to permit user to select required SWAG snippets. This is accessible from the new "Snippets | Import Snippets From SWAG" menu option. - - Snippets are imported into a new "SWAG Imports" category. -+ Implemented feature request #80 "Enable detail pane tabs to be re-ordered" ~~(http://bit.ly/13cbjTZ)~~. -+ In detail pane source code and compiler table now display horizontal scroll bars if they do not fit within the width of the pane. This implements feature requests #60 ~~(http://bit.ly/17iCzT4)~~ and #61 ~~(http://bit.ly/1coDJ5f)~~. -+ Minor changes to dialogue box that appears during long operations. -+ Fixed bug #86 "Snippets are sorted by snippet name in snippet table listings in detail pane" ~~(http://bit.ly/17iD27H)~~. -+ Fixed a few code errors that could have surfaced as bugs. -+ Modified how HTML based detail pane display is generated and displayed. -+ Some refactoring. -+ Updated some 3rd party code to latest available versions. -+ Updated help file re changes. -+ Updated privacy statement. - +* Implemented [SourceForge] feature request #71: "Support importing of one or more snippets from the SWAG database": + * Uses DelphiDabbler SWAG web service to get SWAG data. + * New wizard to permit user to select required SWAG snippets. This is accessible from the new "Snippets | Import Snippets From SWAG" menu option. + * Snippets are imported into a new "SWAG Imports" category. +* Implemented [SourceForge] feature request #80: "Enable detail pane tabs to be re-ordered". +* In detail pane source code and compiler table now display horizontal scroll bars if they do not fit within the width of the pane. This implements [SourceForge] feature requests #60 and #61. +* Minor changes to dialogue box that appears during long operations. +* Fixed [SourceForge] bug #86: "Snippets are sorted by snippet name in snippet table listings in detail pane". +* Fixed a few code errors that could have surfaced as bugs. +* Modified how HTML based detail pane display is generated and displayed. +* Some refactoring. +* Updated some 3rd party code to latest available versions. +* Updated help file re changes. +* Updated privacy statement. ## Release v4.6.4 of 24 July 2013 -+ Fix for IE 9 related browser control script bugs introduced in v4.6.3 when IE 10 bugs were fixed: - - Bug #84 "Script errors on startup" ~~(http://bit.ly/13bfaAL)~~. - - Bug #85 "Check For Updates link " ~~(http://bit.ly/1656pgE)~~. - +* Fix for IE 9 related browser control script bugs introduced in v4.6.3 when IE 10 bugs were fixed: + * [SourceForge] Bug #84: "Script errors on startup" + * [SourceForge] Bug #85: "Check For Updates link" ## Release v4.6.3 of 14 July 2013 -+ Further fix for IE 10 related bug #75 "Floating point error in 4.4.1" ~~(http://bit.ly/12zAWSp)~~. Re-implemented method used to display content in main window's detail pane using the IE web browser control. - +* Further fix for IE 10 related [SourceForge] bug #75 "Floating point error in 4.4.1". Re-implemented method used to display content in main window's detail pane using the IE web browser control. ## Release v4.6.2 of 09 July 2013 -+ Tentative fix for bug #83 "Error when the main form is shown" ~~(http://bit.ly/12eUV5Y)~~ that has been reported on Windows 8. The fix is tentative because the bug hasn't been reproduced. - +* Tentative fix for [SourceForge] bug #83: "Error when the main form is shown" that has been reported on Windows 8. The fix is tentative because the bug hasn't been reproduced. ## Release v4.6.1 of 01 July 2013 -+ Provided fix for reported bug #75 "Floating point error in 4.4.1" ~~(http://bit.ly/12zAWSp)~~ that apparently affects Windows 8, probably with IE 10 installed. -+ Fixed unreported bug where IE 10 browser was being reported as IE 9. -+ Fixed potential bug in code that processes class / advanced record snippet types ready for test compilation and inclusion in generated units. - +* Provided fix for reported [SourceForge] bug #75: "Floating point error in 4.4.1" that apparently affects Windows 8, probably with IE 10 installed. +* Fixed unreported bug where IE 10 browser was being reported as IE 9. +* Fixed potential bug in code that processes class / advanced record snippet types ready for test compilation and inclusion in generated units. ## Release v4.6.0 of 02 June 2013 -+ Added new options to "Find Cross References" dialogue box to allow snippets that either cross reference or depend upon the selected snippet to be included in the search. This implements feature request #30 ~~(http://bit.ly/13cYImA)~~. -+ Added a new "Select and Close" button to the Dependencies dialogue box that causes the snippets displayed on the current tab to be selected in the main display. This implements feature request #77 ~~(http://bit.ly/15s8fH2)~~. -+ The background colour of source code displayed in the main display can now be customised via a new option on the Display tab of the Preferences dialogue box. This implements feature request #36 ~~(http://bit.ly/17fxMGW)~~. -+ CodeSnip now compiled with Delphi XE. -+ Per-user configuration file format changed to v15 which is not entirely compatible with previous versions of CodeSnip. -+ Updated help file re changes. - +* Added new options to "Find Cross References" dialogue box to allow snippets that either cross reference or depend upon the selected snippet to be included in the search. This implements [SourceForge] feature request #30. +* Added a new "Select and Close" button to the Dependencies dialogue box that causes the snippets displayed on the current tab to be selected in the main display. This implements [SourceForge] feature request #77. +* The background colour of source code displayed in the main display can now be customised via a new option on the Display tab of the Preferences dialogue box. This implements [SourceForge] feature request #36. +* CodeSnip now compiled with Delphi XE. +* Per-user configuration file format changed to v15 which is not entirely compatible with previous versions of CodeSnip. +* Updated help file re changes. ## Release v4.5.1 of 15 May 2013 -+ Added progress bars or marquees to several database operations that can take a long time on slower storage devices, i.e.: - - When local files are being updated after downloading an updated database in the Update From Web dialogue box. This fixes bug #79 ~~(https://sourceforge.net/p/codesnip/bugs/79/)~~: - - When the local database is being saved. - - When the local database is being backed up or restored. - - When the local database is being moved to a new location. -+ The user database can now be relocated to a network drive. This fixes issue #81 "Move database to a network drive" ~~(https://sourceforge.net/p/codesnip/bugs/81/)~~. -+ Fixed issue #80 "HTML output bug" ~~(https://sourceforge.net/p/codesnip/bugs/80/)~~. -+ Fixed minor alignment bug that occurred when displaying a wait dialogue box over the main window. -+ Some refactoring. -+ Updated help file re changes. - +* Added progress bars or marquees to several database operations that can take a long time on slower storage devices, i.e.: + * When local files are being updated after downloading an updated database in the Update From Web dialogue box. This fixes [SourceForge] bug #79: + * When the local database is being saved. + * When the local database is being backed up or restored. + * When the local database is being moved to a new location. +* The user database can now be relocated to a network drive. This fixes [SourceForge] issue #81 "Move database to a network drive". +* Fixed [SourceForge] issue #80 "HTML output bug". +* Fixed minor alignment bug that occurred when displaying a wait dialogue box over the main window. +* Some refactoring. +* Updated help file re changes. ## Release v4.5.0 of 02 May 2013 -+ Added support for Delphi XE4 compiler. Implements feature request #78 ~~(http://bit.ly/10uGhoD)~~. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for Delphi XE4 compiler. Implements [SourceForge] feature request #78. +* Updated documentation re changes. +* Updated help file re changes. ## Release v4.4.2 of 26 April 2013 -+ Fixed bugs: - - #76 ~~(http://bit.ly/12Loz5o)~~ - An advanced record snippet with a method name that clashes with a directive is not test compiling correctly. - - #77 ~~(http://bit.ly/11I9wXI)~~ - Syntax highlighter highlights "contains", "requires" and "package" directives when used in method names. - - #78 ~~(http://bit.ly/ZQl3T4)~~ - CodeSnip doesn't restore window in correct position when task bar on left or top of screen. - +* Fixed [SourceForge] bugs: + * #76: An advanced record snippet with a method name that clashes with a directive is not test compiling correctly. + * #77: Syntax highlighter highlights "contains", "requires" and "package" directives when used in method names. + * #78: CodeSnip doesn't restore window in correct position when task bar on left or top of screen. ## Release v4.4.1 of 09 April 2013 -+ Fixed bug #73 "Attempting to check for program updates returns a 404 'Not found' error" ~~(http://bit.ly/Yf3UGy)~~ - this error happened only when using remote server, not localhost test server. - +* Fixed [SourceForge] bug #73: "Attempting to check for program updates returns a 404 'Not found' error" - this error happened only when using remote server, not localhost test server. ## Release v4.4.0 of 08 April 2013 -+ Implemented feature request #75 "Check for updates on start-up" ~~(http://bit.ly/ZJ8OGH)~~: - - CodeSnip checks for both program and Code Snippets Database updates in low priority background threads that run when the program is first started. - - Update checking takes place at intervals between once per day and once per month. - - A new "Updates" tab was added to the "Preferences" dialogue box where update frequencies can be chosen, or the auto-update feature switched off. Program and database update checking can be configured individually. - - Updates are notified via a new slide-in, slide-out notification window that is displayed for a fixed amount of time or until closed by the user. The notification window contains a button that can be used to initiate the appropriate update. For database updates the "Update From Web" dialogue box is opened while for program updates a suitable download web page is displayed in the default browser. - - Program checking is edition specific, i.e. the standard edition checks for standard edition updates and the portable edition behaves similarly. -+ A new "Update Checks" section was added the welcome screen that gives information about the current auto-update settings and provides a link to change them. Some other text on the screen was tweaked. -+ The "Check For Program Updates" dialogue box now opens the correct version and edition specific web page to download the latest version of CodeSnip instead of simply opening a general download page. -+ A new CodeSnip specific program update web service on the codesnip.delphidabbler.com sub-domain is now used to get information about CodeSnip updates instead of the generic update service on delphidabbler.com. -+ Additional usage information is now sent to the DelphiDabbler Code Snippets database update web service. -+ Some refactoring and code clean-up. -+ The installer may now display an information page that describes the new automatic update checking feature. This page is displayed only when updating from v4.3.0 or earlier to v4.4.0 (or later). -+ Updated help file: - - Updated and added help topics for all new features of the release. - - Updated "What's New" topic re new features. -+ Updated documentation, including privacy statement, with information about automatic update checking. -+ Per-user configuration file format changed to v13 which is incompatible with previous versions of CodeSnip. - +* Implemented [SourceForge] feature request #75 "Check for updates on start-up": + * CodeSnip checks for both program and Code Snippets Database updates in low priority background threads that run when the program is first started. + * Update checking takes place at intervals between once per day and once per month. + * A new "Updates" tab was added to the "Preferences" dialogue box where update frequencies can be chosen, or the auto-update feature switched off. Program and database update checking can be configured individually. + * Updates are notified via a new slide-in, slide-out notification window that is displayed for a fixed amount of time or until closed by the user. The notification window contains a button that can be used to initiate the appropriate update. For database updates the "Update From Web" dialogue box is opened while for program updates a suitable download web page is displayed in the default browser. + * Program checking is edition specific, i.e. the standard edition checks for standard edition updates and the portable edition behaves similarly. +* A new "Update Checks" section was added the welcome screen that gives information about the current auto-update settings and provides a link to change them. Some other text on the screen was tweaked. +* The "Check For Program Updates" dialogue box now opens the correct version and edition specific web page to download the latest version of CodeSnip instead of simply opening a general download page. +* A new CodeSnip specific program update web service on the codesnip.delphidabbler.com sub-domain is now used to get information about CodeSnip updates instead of the generic update service on delphidabbler.com. +* Additional usage information is now sent to the DelphiDabbler Code Snippets database update web service. +* Some refactoring and code clean-up. +* The installer may now display an information page that describes the new automatic update checking feature. This page is displayed only when updating from v4.3.0 or earlier to v4.4.0 (or later). +* Updated help file: + * Updated and added help topics for all new features of the release. + * Updated "What's New" topic re new features. +* Updated documentation, including privacy statement, with information about automatic update checking. +* Per-user configuration file format changed to v13 which is incompatible with previous versions of CodeSnip. ## Release v4.3.0 of 27 February 2013 -+ Implemented feature request #40 "Add 'Namespaces' tab to Configure Compilers dialogue box" ~~(http://bit.ly/12XsX32)~~. The new tab appears only for Delphi XE2 and later and obviates the need to manually create -NS commands for passing to the compilers. Suitable default namespaces are provided if none have been configured. -+ Implemented feature request #70 "Let user specify location of user database" ~~(http://bit.ly/13aNCQZ)~~. This feature is accessed from the new "Move Use Database" option on the Database menu. NOTE: The feature is not available in the portable edition which is designed to keep the user database together with the program. -+ Implemented feature request #69 "Enable custom syntax highlighter styles to be saved" ~~(http://bit.ly/XQHkOI)~~. The Syntax Highlighter tab of the Preferences dialogue box has been modified to enable custom syntax highlighter attributes to be saved under a given name and existing named styles to be used or deleted. -+ Changed name of "Delphi 2006" predefined syntax highlighter to "RAD Studio". This remains the default highlighter. -+ A little refactoring. -+ Enlarged Configure Compilers dialogue box. -+ Updated help file: - - Updated and added help topics re all new features in the release. - - Updated "What's New" topic re new features. - - Removed help topic for "Browse For Folders" dialogue box accessed from Search Paths tab of Configure Compilers dialogue. -+ Per-user configuration file format changed to v12 which is not fully compatible with previous versions of CodeSnip. -+ Updated documentation. - +* Implemented [SourceForge] feature request #40: "Add 'Namespaces' tab to Configure Compilers dialogue box". The new tab appears only for Delphi XE2 and later and obviates the need to manually create -NS commands for passing to the compilers. Suitable default namespaces are provided if none have been configured. +* Implemented [SourceForge] feature request #70: "Let user specify location of user database". This feature is accessed from the new "Move Use Database" option on the Database menu. NOTE: The feature is not available in the portable edition which is designed to keep the user database together with the program. +* Implemented [SourceForge] feature request #69: "Enable custom syntax highlighter styles to be saved". The Syntax Highlighter tab of the Preferences dialogue box has been modified to enable custom syntax highlighter attributes to be saved under a given name and existing named styles to be used or deleted. +* Changed name of "Delphi 2006" predefined syntax highlighter to "RAD Studio". This remains the default highlighter. +* A little refactoring. +* Enlarged Configure Compilers dialogue box. +* Updated help file: + * Updated and added help topics re all new features in the release. + * Updated "What's New" topic re new features. + * Removed help topic for "Browse For Folders" dialogue box accessed from Search Paths tab of Configure Compilers dialogue. +* Per-user configuration file format changed to v12 which is not fully compatible with previous versions of CodeSnip. +* Updated documentation. ## Release v4.2.1 of 14 February 2013 -+ Bug fix: changed Favourites dialogue to display snippet display names instead of unique names. Fixes bug #72 ~~(http://bit.ly/Vj6ZCM)~~. -+ Updated program copyright date in About box. - +* Bug fix: changed Favourites dialogue to display snippet display names instead of unique names. Fixes [SourceForge] bug #72. +* Updated program copyright date in About box. ## Release v4.2.0 of 07 February 2013 -+ Added support for "favourite" snippets. Implements feature request #37 ~~(http://bit.ly/12unShW)~~: - - Any displayed snippet can be flagged as a favourite via a menu option or toolbar button. - - A new non-modal dialogue box can now be displayed alongside the CodeSnip window for easy selection and management of favourite snippets. -+ Changes to Duplicate Snippets dialogue box: - - Display name of duplicate snippet can be edited. Implements feature request #64 ~~(http://bit.ly/14TdUGF)~~. - - Snippets Editor can be opened immediately the Duplicate Snippet dialogue box closes to edit the duplicated snippet. Implements feature request #65 ~~(http://bit.ly/UBlt2Y)~~. -+ Status bar changed: first panel now displays no category information, but displays both total number of snippets and number of snippets in each database. -+ Fixed unreported bug in save dialogue boxes where overwrite permission requests could be displayed erroneously. -+ Program closes gracefully if run on unsupported versions. -+ Updated some 3rd party code to latest available versions. -+ Some refactoring. -+ Per-user configuration file format changed to v11 which is not fully compatible with older versions of CodeSnip. -+ Updated help file re changes in Duplicate Snippets dialogue box and addition of support for Favourites. -+ Updated documentation. - +* Added support for "favourite" snippets. Implements [SourceForge] feature request #37: + * Any displayed snippet can be flagged as a favourite via a menu option or toolbar button. + * A new non-modal dialogue box can now be displayed alongside the CodeSnip window for easy selection and management of favourite snippets. +* Changes to Duplicate Snippets dialogue box: + * Display name of duplicate snippet can be edited. Implements [SourceForge] feature request #64. + * Snippets Editor can be opened immediately the Duplicate Snippet dialogue box closes to edit the duplicated snippet. Implements [SourceForge] feature request #65. +* Status bar changed: first panel now displays no category information, but displays both total number of snippets and number of snippets in each database. +* Fixed unreported bug in save dialogue boxes where overwrite permission requests could be displayed erroneously. +* Program closes gracefully if run on unsupported versions. +* Updated some 3rd party code to latest available versions. +* Some refactoring. +* Per-user configuration file format changed to v11 which is not fully compatible with older versions of CodeSnip. +* Updated help file re changes in Duplicate Snippets dialogue box and addition of support for Favourites. +* Updated documentation. ## Release v4.1.1 of 30 January 2013 -+ Fixed bugs: - - #68 ~~(http://bit.ly/WxG6LC)~~: Comments missing in unit / code generation for some types. - - #70 ~~(http://bit.ly/WAYEHN)~~: Changing syntax highlighter font has no effect in main display. - - #71 ~~(http://bit.ly/14v9i9v)~~: Option to select monochrome printing not working properly. - - Unreported: Changing syntax highlighter font has no effect when printing or when copying text to clipboard as RTF (related to bug #70). -+ Updated help file re syntax highlighter changes. - +* Fixed [SourceForge] bugs: + * #68: Comments missing in unit / code generation for some types. + * #70: Changing syntax highlighter font has no effect in main display. + * #71: Option to select monochrome printing not working properly. + * Unreported: Changing syntax highlighter font has no effect when printing or when copying text to clipboard as RTF (related to bug #70). +* Updated help file re syntax highlighter changes. ## Release v4.1.0 of 06 January 2013 -+ This is the first non-beta release to made available in both standard and portable editions, compiled from a common code base. The portable edition differs from the standard as follows (as per release v4.0.1 portable beta 1): - - Executable file name is CodeSnip-p.exe. - - Program caption identifies program as portable version. - - Data directories are sub-directories of executable program directory. - - Common file dialogue boxes default to program's working directory. - - First run processing does not give the option to import old settings or existing user databases. - - Different version information and program identifier. - - There is no set up program. -+ Changes to snippets editor: - - Added context menus to cross-references and dependencies check box lists. Both have menu item to clear list. Dependencies list has item to view dependencies. Implements feature request #3560960 ~~(http://bit.ly/U83Swh)~~. - - Deleted "View Dependencies" button now that its functionality is now on context menu. - - Enlarged various controls on all except "Code" tab. - - Units listed on "References" tab is now persistent. Units can be removed, defaults restored and selection cleared via a new context menu. Implements feature request #3560962 ~~(http://bit.ly/UM0c0B)~~. -+ New source code formatting option added to only use first paragraph of a snippet description as snippet comment in generated code. This is configured via "Code Formatting" tab of "Preferences" dialogue box and / or from relevant "Save" dialogue boxes. Implements feature request #3560647 ~~(http://bit.ly/UQrDax)~~. -+ Changed mini-toolbar in overview pane to expand / collapse all overview tree view instead of just selected node. Implements feature request #3560646 ~~(http://bit.ly/UOUQTr)~~. -+ Reimplemented database search engine. -+ Some external links modified that will seamlessly accommodate future changes in destination URLs. -+ Changed some glyphs used in menus. -+ Per-user configuration file format changed: bumped file version to 10. -+ Some refactoring. -+ Help file updated re changes & added privacy statement to TOC. -+ Updated documentation: - - Re changes to source code repository and bug / feature request trackers. - - Re portable version. - +* This is the first non-beta release to made available in both standard and portable editions, compiled from a common code base. The portable edition differs from the standard as follows (as per release v4.0.1 portable beta 1): + * Executable file name is CodeSnip-p.exe. + * Program caption identifies program as portable version. + * Data directories are sub-directories of executable program directory. + * Common file dialogue boxes default to program's working directory. + * First run processing does not give the option to import old settings or existing user databases. + * Different version information and program identifier. + * There is no set up program. +* Changes to snippets editor: + * Added context menus to cross-references and dependencies check box lists. Both have menu item to clear list. Dependencies list has item to view dependencies. Implements [SourceForge] feature request #3560960. + * Deleted "View Dependencies" button now that its functionality is now on context menu. + * Enlarged various controls on all except "Code" tab. + * Units listed on "References" tab is now persistent. Units can be removed, defaults restored and selection cleared via a new context menu. Implements [SourceForge] feature request #3560962. +* New source code formatting option added to only use first paragraph of a snippet description as snippet comment in generated code. This is configured via "Code Formatting" tab of "Preferences" dialogue box and / or from relevant "Save" dialogue boxes. Implements [SourceForge] feature request #3560647. +* Changed mini-toolbar in overview pane to expand / collapse all overview tree view instead of just selected node. Implements [SourceForge] feature request #3560646. +* Reimplemented database search engine. +* Some external links modified that will seamlessly accommodate future changes in destination URLs. +* Changed some glyphs used in menus. +* Per-user configuration file format changed: bumped file version to 10. +* Some refactoring. +* Help file updated re changes & added privacy statement to TOC. +* Updated documentation: + * Re changes to source code repository and bug / feature request trackers. + * Re portable version. ## Release v4.0.2 of 17 December 2012 -+ Improvements to keyboard handling: - - Fixed some keyboard focus bugs. - - Fixed broken, missing and duplicate Alt-key short-cuts in several dialogue boxes. - - Fixed broken keyboard access to list view in Code Generation tab of Preferences dialogue box. -+ Corrected an incorrect font in Compilers dialogue box. -+ Added title to "View Link" dialogue box displayed from mark-up editor. -+ Corrected error in "Submit Code to the Database" task help topic. - +* Improvements to keyboard handling: + * Fixed some keyboard focus bugs. + * Fixed broken, missing and duplicate Alt-key short-cuts in several dialogue boxes. + * Fixed broken keyboard access to list view in Code Generation tab of Preferences dialogue box. +* Corrected an incorrect font in Compilers dialogue box. +* Added title to "View Link" dialogue box displayed from mark-up editor. +* Corrected error in "Submit Code to the Database" task help topic. ## Release v4.0.1 portable edition, beta 1 of 12 December 2012 -_Internal CodeSnip version 4.0.1.213_ - -+ Modified version of Release v4.0.1 that can run from a writeable removable medium without writing files or registry on host computer. This implements feature request #3577431 ~~(http://bit.ly/UxvUj0)~~. -+ Changes that apply only to portable version: - - Changed executable file name to CodeSnip-p.exe. - - Program caption changed to identify as portable version. - - Data directories changed to be sub-directories of executable program directory. - - Changed common file dialogue boxes to working directory by default. - - First run processing no longer gives option to import old settings or existing user databases. - - Different version information and program identifier format. - - No set up program. -+ Code base modified to conditionally compile either portable or standard edition. -+ Updated documentation, including privacy statement. +Internal CodeSnip version 4.0.1.213 +* Modified version of Release v4.0.1 that can run from a writeable removable medium without writing files or registry on host computer. This implements [SourceForge] feature request #3577431. +* Changes that apply only to portable version: + * Changed executable file name to CodeSnip-p.exe. + * Program caption changed to identify as portable version. + * Data directories changed to be sub-directories of executable program directory. + * Changed common file dialogue boxes to working directory by default. + * First run processing no longer gives option to import old settings or existing user databases. + * Different version information and program identifier format. + * No set up program. +* Code base modified to conditionally compile either portable or standard edition. +* Updated documentation, including privacy statement. ## Release v4.0.1 of 08 December 2012 -_Internal CodeSnip version 4.0.1.212_ - -+ Fixed bug #3578652 ~~(http://bit.ly/RXIwBC)~~: "Pre-processor directive errors in main db ini files" by removing support for problematic directives. -+ Rolling mouse over links in detail pane no longer displays a hint in the status bar. This change fixes bug #3577407 ~~(http://bit.ly/VeSVGg)~~: Clicking detail pane snippet link leaves hint in status bar. -+ Windows no longer scale automatically when screen DPI differs from that on design system. This fixes bugs #3591818 ~~(http://bit.ly/TvNaUL)~~ "Strange window behaviour in Windows 7" and bug #3591820 ~~(http://bit.ly/SEH6dO)~~ "Incorrect font size used for some bold text". -+ Update operating system detection code to detect Windows 8 & 2012 server. -+ Some refactoring and some redundant code removed. -+ Updated documentation. -+ Updated help topic that describes main display. +Internal CodeSnip version 4.0.1.212 +* Fixed [SourceForge] bug #3578652: "Pre-processor directive errors in main db ini files" by removing support for problematic directives. +* Rolling mouse over links in detail pane no longer displays a hint in the status bar. This change fixes [SourceForge] bug #3577407: Clicking detail pane snippet link leaves hint in status bar. +* Windows no longer scale automatically when screen DPI differs from that on design system. This fixes [SourceForge] bug #3591818: "Strange window behaviour in Windows 7" and [SourceForge] bug #3591820: "Incorrect font size used for some bold text". +* Update operating system detection code to detect Windows 8 & 2012 server. +* Some refactoring and some redundant code removed. +* Updated documentation. +* Updated help topic that describes main display. ## Release v4.0.0 of 12 October 2012 @@ -475,1886 +666,1674 @@ _Final v4 release._ See also changes from alpha, beta and release candidates below for details of changes since v3.9.3. -+ New glyphs that describes level of testing applied to snippets from online Code Snippets Database now appear in top right of detail pane. -+ Changed main window caption and task bar entry to include version number "4" after program name. -+ Fixed bugs: - - #3572382 ~~(http://bit.ly/OnEtNY)~~: Automatic conversion of blank lines to paragraphs in REML mark-up editor gets confused if block level tags are already present. - - Unreported: Controls in News dialogue box do not use correct font. -+ A little refactoring. -+ Updated help file: - - Modified re recent changes - - Added new "What's new" topic giving details of changes in v4. Implements feature request #3567490 ~~(http://bit.ly/RgQx0W)~~. - - Renamed "Welcome" page as "Overview". -+ Updated documentation, including read-me file. - +* New glyphs that describes level of testing applied to snippets from online Code Snippets Database now appear in top right of detail pane. +* Changed main window caption and task bar entry to include version number "4" after program name. +* Fixed bugs: + * [SourceForge] bug #3572382 Automatic conversion of blank lines to paragraphs in REML mark-up editor gets confused if block level tags are already present. + * Unreported: Controls in News dialogue box do not use correct font. +* A little refactoring. +* Updated help file: + * Modified re recent changes + * Added new "What's new" topic giving details of changes in v4. Implements [SourceForge] feature request. + * Renamed "Welcome" page as "Overview". +* Updated documentation, including read-me file. ## Release v4.0 RC 3 of 18 September 2012 -_Internal CodeSnip version 3.999.3_ - -+ Fixed serious bug #3568628 ~~(http://bit.ly/V5NX0H)~~: "CodeSnip faulting at startup after fresh install with no previous v3 installation". +Internal CodeSnip version 3.999.3 +* Fixed serious [SourceForge] bug #3568628: "CodeSnip faulting at startup after fresh install with no previous v3 installation". ## Release v4.0 RC 2 of 17 September 2012 -_Internal CodeSnip version 3.999.2_ - -+ Fixed serious bug #3568515 ~~(http://bit.ly/Oy2Q7g)~~: Duplicating a snippet with a display name causes crash. -+ Minor update to licensing information and about box credits. +Internal CodeSnip version 3.999.2 +* Fixed serious [SourceForge] bug #3568515: Duplicating a snippet with a display name causes crash. +* Minor update to licensing information and about box credits. ## Release v4.0 RC 1 of 14 September 2012 -_Internal CodeSnip version 3.999.1_ - -+ UI changes: - - Welcome page completely revised. Instead of a program overview the page now describes the state of the databases and available compilers and displays help links and a donation request. There are also some links to the about box, news and program updates. - - Many changes to glyphs used in menus and toolbar. - - Removed some images that relate to trade marks, i.e. PayPal Donate button and Delphi compiler icons. - - No clicking noise is now issued by UI in response to user interaction with Details pane. - - Links to external commands and to other snippets re-styled. - - Revised and updated program's main icon. -+ Fixed bug #3566426 ~~(http://bit.ly/OmbwTB)~~: About Box Paths Page displays wrongly when themes not available. -+ Added support for Delphi XE3 compiler. Implements feature request #3566346 ~~(http://bit.ly/SIVpS2)~~. -+ Completely new Easter Egg. -+ Refactoring and internal code changes, including a revision of the "external" object that communicates with JavaScript in browser controls. -+ Changed License: - - EULA for executable code changed to Mozilla Public License v2.0. - - Most original source code changed to Mozilla Public License v2.0 from v1.1. - - Only an abbreviated version of the license is now displayed by the installer and in the help file. - - License information has been consolidated into a new file: License.html. -+ About box changed re new license and changes in required and voluntary acknowledgements and credits. -+ Help file updated. -+ Documentation updated. - +Internal CodeSnip version 3.999.1 + +* UI changes: + * Welcome page completely revised. Instead of a program overview the page now describes the state of the databases and available compilers and displays help links and a donation request. There are also some links to the about box, news and program updates. + * Many changes to glyphs used in menus and toolbar. + * Removed some images that relate to trade marks, i.e. PayPal Donate button and Delphi compiler icons. + * No clicking noise is now issued by UI in response to user interaction with Details pane. + * Links to external commands and to other snippets re-styled. + * Revised and updated program's main icon. +* Fixed [SourceForge] bug #3566426: About Box Paths Page displays wrongly when themes not available. +* Added support for Delphi XE3 compiler. Implements [SourceForge] feature request #3566346. +* Completely new Easter Egg. +* Refactoring and internal code changes, including a revision of the "external" object that communicates with JavaScript in browser controls. +* Changed License: + * EULA for executable code changed to Mozilla Public License v2.0. + * Most original source code changed to Mozilla Public License v2.0 from v1.1. + * Only an abbreviated version of the license is now displayed by the installer and in the help file. + * License information has been consolidated into a new file: License.html. +* About box changed re new license and changes in required and voluntary acknowledgements and credits. +* Help file updated. +* Documentation updated. ## Release v4.0 beta 2 of 25 August 2012 -_Internal CodeSnip version 3.99.2_ - -+ Bug fixes: - - #3556620 ~~(http://bit.ly/Mq1Khh)~~: Serious flaw in generating units containing class types when the classes contain method types other than procedure or function. - - #3556713 ~~(http://bit.ly/RIzfvQ)~~: Context menus are not displayed when pressing Alt+F10. - - #3556715 ~~(http://bit.ly/O3QN0u)~~: Deleting a category then returning to it via the history list causes a GPF. - - #3556718 ~~(http://bit.ly/RVanCE)~~: Inconsistent context menus for edit controls in Snippets Editor. - - #3557107 ~~(http://bit.ly/PfiYxm)~~: New snippets and categories are not added to the history list. - - #3558649 ~~(http://bit.ly/PAXLQv)~~: Closing the Preferences dialogue always refreshes the main display even if the dialogue box was cancelled or if nothing was changed. - - #3559156 ~~(http://bit.ly/TKXYQ7)~~: "Previews" giving examples of the effect of changes made in the Preferences dialogue box sometimes disappear when the tab key is pressed. - - #3559239 ~~(http://bit.ly/Pm1HU4)~~: Snippet names and display names are used inconsistently in the UI. - - #3559257 ~~(http://bit.ly/Qc8Fqu)~~: Compile Results displayed from the main menu can get out of sync with the actual compile results of snippets that have been edited since they were last compiled. - - #3559265 ~~(http://bit.ly/NvV9iH)~~: Viewing dependencies for an unnamed snippet or a snippet not in the database causes a GPF. - - #3559266 ~~(http://bit.ly/S69wO2)~~: When include files are generated for a snippet that depends on a class type, the required class is not listed in the file's header comments. - - #3560317 ~~(http://bit.ly/PUcEgV)~~: The caption of the Active Text preview dialogue box refers to "Extra" text when it is used to preview a snippet's description. - - #3560521 ~~(http://bit.ly/RG7Jlw)~~: The state of the Overview tree often doesn't restore correctly after a database update. - - #3560958 ~~(http://bit.ly/TX7M9V)~~: Snippets are not sorted correctly (i.e. on display name) in the Overview pane. - - #3561014 ~~(http://bit.ly/PEFgXY)~~: The current view in the Display pane is not cleared, even though all tabs are closed, when the database is re-loading. - - #3561047 ~~(http://bit.ly/Pf5L5v)~~: The Category view in the Overview pane sometimes appears fully expanded when it is expected to be fully collapsed. - - Untracked: Removed "(v4 preview)" text that had been left in main window title bar. - - Untracked: Minor accelerator key related problems in the Preferences dialogue box. -+ Main UI changes: - - The Detail pane tab-set now has a context menu that can be used to close the current tab or all but the current tab. The Close tab option is also added to current view's context menu. - - Right-clicking a tab in the Overview or Detail pane now selects the tab. - - Middle-clicking an item in the Overview pane now selects it. Previously middle clicks were ignored. - - Many more parts of the main display and dialogue boxes now display display names for snippets rather than unique names. - - Ctrl clicking snippet and category links in the Detail pane and History UI controls now opens the chosen item in a new tab. Implements feature requests #3559377 ~~(http://bit.ly/OqnAjd)~~ and #3559378 ~~(http://bit.ly/NPtEkX)~~. - - Different link styles are now used for the different types of link in the Detail pane. Implements feature request #3559464 ~~(http://bit.ly/Pwsqg6)~~. - - Pressing Ctrl+Return on an active snippet or category link in the Details pane now opens the item in a new tab instead of the current tab. Pressing Return now opens the item in the current tab. - - The Detail pane's context menu now displays more options when text selections and links are right clicked. Implements feature request #3559375 ~~(http://bit.ly/NzaY8a)~~ with some minor differences. - - New button added to the Display tab of the Preferences dialogue box that resets default snippet heading colours. Implements feature request #3559140 ~~(http://bit.ly/QKQo43)~~. - - The "Types" unit is now displayed by default in the Snippets Editor Reference Tab's predefined units list. -+ When a category is printed, any URLs in snippet descriptions are output and styled. -+ Names of units referenced by snippets may now contain dots. -+ Some refactoring and internal code changes, including a major reworking of the "first run" program configuration and a revision to the "external" object that communicates with JavaScript in browser controls. -+ Help file updated: - - Re UI changes. - - With a description of the need to configure namespaces for Delphi XE2 for each unit referenced by the code it is test compiling - addresses bug #3536531 ~~(http://bit.ly/Q2bcmY)~~. -+ Updated documentation. - +Internal CodeSnip version 3.99.2 + +* [SourceForge] Bug fixes: + * #3556620: Serious flaw in generating units containing class types when the classes contain method types other than procedure or function. + * #3556713: Context menus are not displayed when pressing Alt+F10. + * #3556715: Deleting a category then returning to it via the history list causes a GPF. + * #3556718: Inconsistent context menus for edit controls in Snippets Editor. + * #3557107: New snippets and categories are not added to the history list. + * #3558649: Closing the Preferences dialogue always refreshes the main display even if the dialogue box was cancelled or if nothing was changed. + * #3559156: "Previews" giving examples of the effect of changes made in the Preferences dialogue box sometimes disappear when the tab key is pressed. + * #3559239: Snippet names and display names are used inconsistently in the UI. + * #3559257: Compile Results displayed from the main menu can get out of sync with the actual compile results of snippets that have been edited since they were last compiled. + * #3559265: Viewing dependencies for an unnamed snippet or a snippet not in the database causes a GPF. + * #3559266: When include files are generated for a snippet that depends on a class type, the required class is not listed in the file's header comments. + * #3560317: The caption of the Active Text preview dialogue box refers to "Extra" text when it is used to preview a snippet's description. + * #3560521: The state of the Overview tree often doesn't restore correctly after a database update. + * #3560958: Snippets are not sorted correctly (i.e. on display name) in the Overview pane. + * #3561014: The current view in the Display pane is not cleared, even though all tabs are closed, when the database is re-loading. + * #3561047: The Category view in the Overview pane sometimes appears fully expanded when it is expected to be fully collapsed. + * Untracked: Removed "(v4 preview)" text that had been left in main window title bar. + * Untracked: Minor accelerator key related problems in the Preferences dialogue box. +* Main UI changes: + * The Detail pane tab-set now has a context menu that can be used to close the current tab or all but the current tab. The Close tab option is also added to current view's context menu. + * Right-clicking a tab in the Overview or Detail pane now selects the tab. + * Middle-clicking an item in the Overview pane now selects it. Previously middle clicks were ignored. + * Many more parts of the main display and dialogue boxes now display display names for snippets rather than unique names. + * Ctrl clicking snippet and category links in the Detail pane and History UI controls now opens the chosen item in a new tab. Implements [SourceForge] feature requests #3559377 and #3559378. + * Different link styles are now used for the different types of link in the Detail pane. Implements [SourceForge] feature request #3559464. + * Pressing Ctrl+Return on an active snippet or category link in the Details pane now opens the item in a new tab instead of the current tab. Pressing Return now opens the item in the current tab. + * The Detail pane's context menu now displays more options when text selections and links are right clicked. Implements [SourceForge] feature request #3559375 with some minor differences. + * New button added to the Display tab of the Preferences dialogue box that resets default snippet heading colours. Implements [SourceForge] feature request #3559140. + * The "Types" unit is now displayed by default in the Snippets Editor Reference Tab's predefined units list. +* When a category is printed, any URLs in snippet descriptions are output and styled. +* Names of units referenced by snippets may now contain dots. +* Some refactoring and internal code changes, including a major reworking of the "first run" program configuration and a revision to the "external" object that communicates with JavaScript in browser controls. +* Help file updated: + * Re UI changes. + * With a description of the need to configure namespaces for Delphi XE2 for each unit referenced by the code it is test compiling - addresses [SourceForge] bug. +* Updated documentation. ## Release v4.0 beta 1 of 11 August 2012 -_Internal CodeSnip version 3.99.1_ - -+ New features: - - Structure of snippet pages in details pane is now customisable: various page elements can be omitted and order of elements can be specified. Each snippet type has its own page customisation. Implements feature request #3519456 ~~(http://bit.ly/NhT8Kr)~~. - - Snippets can now have a "display name" that can contain any characters and does not need to be unique. When provided the display name is displayed in preference to the normal name. Implements feature request #3519460 ~~(http://bit.ly/NN6kRP)~~. - - Snippet descriptions can now be formatted and contain multiple paragraphs. This implements feature requests #3411890 ~~(http://bit.ly/OS8a5a)~~ and #3520405 ~~(http://bit.ly/OS8yRe)~~. - - Snippets can now be configured so that their source code is not syntax highlighted. This change allows snippets in other languages not to be highlighted as if they are Pascal. Implements feature request #3519935 ~~(http://bit.ly/LrNiAg)~~. - - Colour of headings for snippets and categories from main and user databases are now user configurable. This implements feature request #3519463 ~~(http://bit.ly/Nz9JH2)~~. - - User can now limit the number of compilers that appear in the compiler results table in the display pane. This is done via the Configure Compilers dialogue box. Implements feature request #3519459 ~~(http://bit.ly/Q5O51z)~~. - - New option on Tools menu that checks availability of new versions of CodeSnip. -+ User interface changes: - - "Test Compile" link removed from snippet display in details pane. - - "Test Compile" dialogue box changed so that only the installed compilers that CodeSnip uses for test compilation are displayed, instead of all known compilers. - - Welcome page revised. -+ Changes to snippets editor: - - New field on Code tab to enter optional snippet display name. - - New check box on Code tab to specify if Pascal syntax highlighter is to be used for source code. - - New tabbed "mark-up editor" lets user enter multi-paragraph snippet descriptions and extra information either as plain text or as REML mark-up. - - Controls on Code tab re-ordered. - - Extra Information tab revised with much larger edit control and deletion of explanatory text. - - Editor enlarged. -+ Changes to Preferences dialogue box: - - New "Snippet Layout" tab added where composition and layout of snippet pages can be customised. - - "General" preferences tab split into two: "Misc." that contains only measurement units and "Display" that contains display related options. - - Added controls to "Display" tab to set main and user database heading colours. - - Changes that affect appearance of content of details pane are now reflected in the display as soon as the Preferences dialogue box closes, rather than on program restart. -+ Changes to REML mark-up handling: - - Any REML text not embedded in block level tags is now automatically wrapped in `<p>`...`</p>` tags. - - Nested REML block level tags are no longer allowed. - - Changed handling of multiple spaces in REML code to be the same as in HTML. - - Formatting of REML code improved when re-displayed. -+ Bug fixes: - - Bug #3536331 fixed ~~(http://bit.ly/KQTYc3)~~: words at the end of some paragraphs in a snippet's extra information were not being found in "whole word only" searches. - - Fixed unreported file parsing bug that occurred when loading a saved snippet selection from disk. -+ Changed Delphi compiler detection so that compilers can be detected by examining current user registry key in addition to local machine registry key. This enables Delphis that were installed for a given user only to be detected. -+ Improved error handling when reading and writing snippet selection files. -+ User database and export file formats updated to v6. -+ Per-user configuration file format changes: bumped file version to v9. -+ Major changes to installer: - - Now always brings forward any earlier common configuration files if needed. - - Per user configuration files are now ignored: they are handled by main program (see below). - - Only main database, not user database, is now imported from earlier versions on user request. User databases are now handled by main program (see below). - - There is no longer an option to delete old databases or configuration files. - - Updating from a v4 preview (alpha) release causes an extra page to be displayed that gives instructions relating to updating from preview to current release. -+ Program now detects if it is running for first time since updating: - - If this is first run since updating from v3 or earlier a "first run" wizard guides user through importing any old preferences or user databases. - - For point v4.x point updates user configuration file is silently updated as necessary. -+ Significant refactoring. -+ Updated help file in line with changes and new features. -+ Updated documentation, including minor changes to privacy statement and license. - +Internal CodeSnip version 3.99.1 + +* New features: + * Structure of snippet pages in details pane is now customisable: various page elements can be omitted and order of elements can be specified. Each snippet type has its own page customisation. Implements [SourceForge] feature request #3519456. + * Snippets can now have a "display name" that can contain any characters and does not need to be unique. When provided the display name is displayed in preference to the normal name. Implements [SourceForge] feature request #3519460. + * Snippet descriptions can now be formatted and contain multiple paragraphs. This implements [SourceForge] feature requests #3411890 and #3520405. + * Snippets can now be configured so that their source code is not syntax highlighted. This change allows snippets in other languages not to be highlighted as if they are Pascal. Implements [SourceForge] feature request #3519935. + * Colour of headings for snippets and categories from main and user databases are now user configurable. This implements [SourceForge] feature request #3519463. + * User can now limit the number of compilers that appear in the compiler results table in the display pane. This is done via the Configure Compilers dialogue box. Implements [SourceForge] feature request #3519459. + * New option on Tools menu that checks availability of new versions of CodeSnip. +* User interface changes: + * "Test Compile" link removed from snippet display in details pane. + * "Test Compile" dialogue box changed so that only the installed compilers that CodeSnip uses for test compilation are displayed, instead of all known compilers. + * Welcome page revised. +* Changes to snippets editor: + * New field on Code tab to enter optional snippet display name. + * New check box on Code tab to specify if Pascal syntax highlighter is to be used for source code. + * New tabbed "mark-up editor" lets user enter multi-paragraph snippet descriptions and extra information either as plain text or as REML mark-up. + * Controls on Code tab re-ordered. + * Extra Information tab revised with much larger edit control and deletion of explanatory text. + * Editor enlarged. +* Changes to Preferences dialogue box: + * New "Snippet Layout" tab added where composition and layout of snippet pages can be customised. + * "General" preferences tab split into two: "Misc." that contains only measurement units and "Display" that contains display related options. + * Added controls to "Display" tab to set main and user database heading colours. + * Changes that affect appearance of content of details pane are now reflected in the display as soon as the Preferences dialogue box closes, rather than on program restart. +* Changes to REML mark-up handling: + * Any REML text not embedded in block level tags is now automatically wrapped in `<p>`...`</p>` tags. + * Nested REML block level tags are no longer allowed. + * Changed handling of multiple spaces in REML code to be the same as in HTML. + * Formatting of REML code improved when re-displayed. +* Bug fixes: + * [SourceForge] bug #3536331 fixed: words at the end of some paragraphs in a snippet's extra information were not being found in "whole word only" searches. + * Fixed unreported file parsing bug that occurred when loading a saved snippet selection from disk. +* Changed Delphi compiler detection so that compilers can be detected by examining current user registry key in addition to local machine registry key. This enables Delphis that were installed for a given user only to be detected. +* Improved error handling when reading and writing snippet selection files. +* User database and export file formats updated to v6. +* Per-user configuration file format changes: bumped file version to v9. +* Major changes to installer: + * Now always brings forward any earlier common configuration files if needed. + * Per user configuration files are now ignored: they are handled by main program (see below). + * Only main database, not user database, is now imported from earlier versions on user request. User databases are now handled by main program (see below). + * There is no longer an option to delete old databases or configuration files. + * Updating from a v4 preview (alpha) release causes an extra page to be displayed that gives instructions relating to updating from preview to current release. +* Program now detects if it is running for first time since updating: + * If this is first run since updating from v3 or earlier a "first run" wizard guides user through importing any old preferences or user databases. + * For point v4.x point updates user configuration file is silently updated as necessary. +* Significant refactoring. +* Updated help file in line with changes and new features. +* Updated documentation, including minor changes to privacy statement and license. ## Release v4.0 alpha 3 (preview) of 18 June 2012 -_Internal CodeSnip version 3.98.3_ - -+ New features: - - Compiler warnings can now be switched on as well as off in generated code. - - Names and descriptions of snippets in a category can now be printed. - - Text and compiler searches can now be nested so that the later search refines the earlier one. - - Current selection (i.e. search result set) can be saved to disk and loaded again later. -+ User interface changes: - - Overview pane now displays buttons that can be used to collapse or expand non-empty section headings. - - Ctrl + arrow keys can now be used to scroll overview pane tree view vertically and horizontally without changing selection in overview pane. - - Main window is now refreshed whenever changes that affect it are made in the Preferences dialogue box. - - Some main menu short-cut keys changed. - - Dependencies dialogue box now has two tabs: the first displays the snippets required to compile the selected snippet while the second tab displays snippets that depend upon the selected snippet. - - Code Generation tab of Preferences dialogue box updated to enable warnings to be switched on or off. In addition default warnings can be restored, list view columns can be sorted and Alt key short-cuts tweaked. - - Code Import dialogue box improved: now sorts imported units in list view and scrolls to make renamed snippets visible. - - Snippet selection and cross-reference search dialogues now report if existing search results will be overwritten. - - Text and compiler search dialogues now ask if any current search results are to be refined. - - Tree views in Snippet Selection, Snippets export and Snippets submission dialogue boxes can now be expanded and collapsed. - - Appearance of message boxes tweaked. - - Program tab of About box updated with credits for new third party code. -+ Bug fixes: - - Error in logic of code that generates program ID was fixed. - - Bug #2868708 fixed ~~(http://bit.ly/KeyAvS)~~: edited snippets are no longer lost from manual snippet selections unless snippet names are changed. - - Bug #3534138 fixed ~~(http://bit.ly/Mg9gJG)~~: details pane display is now cleared when last tab is closed: previously content of last closed tab remained on screen. -+ Info about user's OS and IE version is now sent to web server during online database updates. -+ Some refactoring. -+ Help file updated in line with changes and new features. Some US English spellings changed to UK English for consistency. -+ Updated documentation, including: - - Privacy statement updated re changes in data recorded via database update log-ons. - - Licensing docs updated re introduction of some MPL 2.0 files. - +Internal CodeSnip version 3.98.3 + +* New features: + * Compiler warnings can now be switched on as well as off in generated code. + * Names and descriptions of snippets in a category can now be printed. + * Text and compiler searches can now be nested so that the later search refines the earlier one. + * Current selection (i.e. search result set) can be saved to disk and loaded again later. +* User interface changes: + * Overview pane now displays buttons that can be used to collapse or expand non-empty section headings. + * Ctrl+arrow keys can now be used to scroll overview pane tree view vertically and horizontally without changing selection in overview pane. + * Main window is now refreshed whenever changes that affect it are made in the Preferences dialogue box. + * Some main menu short-cut keys changed. + * Dependencies dialogue box now has two tabs: the first displays the snippets required to compile the selected snippet while the second tab displays snippets that depend upon the selected snippet. + * Code Generation tab of Preferences dialogue box updated to enable warnings to be switched on or off. In addition default warnings can be restored, list view columns can be sorted and Alt key short-cuts tweaked. + * Code Import dialogue box improved: now sorts imported units in list view and scrolls to make renamed snippets visible. + * Snippet selection and cross-reference search dialogues now report if existing search results will be overwritten. + * Text and compiler search dialogues now ask if any current search results are to be refined. + * Tree views in Snippet Selection, Snippets export and Snippets submission dialogue boxes can now be expanded and collapsed. + * Appearance of message boxes tweaked. + * Program tab of About box updated with credits for new third party code. +* Bug fixes: + * Error in logic of code that generates program ID was fixed. + * [SourceForge] Bug #2868708 fixed: edited snippets are no longer lost from manual snippet selections unless snippet names are changed. + * [SourceForge] Bug #3534138 fixed: details pane display is now cleared when last tab is closed: previously content of last closed tab remained on screen. +* Info about user's OS and IE version is now sent to web server during online database updates. +* Some refactoring. +* Help file updated in line with changes and new features. Some US English spellings changed to UK English for consistency. +* Updated documentation, including: + * Privacy statement updated re changes in data recorded via database update log-ons. + * Licensing docs updated re introduction of some MPL 2.0 files. ## Release v4.0 alpha 2 (preview) of 21 April 2012 -_Internal CodeSnip version 3.98.2_ - -+ New features: - - New "unit" snippet type that enables complete units to be stored in database and to be test compiled. - - New "classes" snippet type that enables a single Object Pascal class or advanced record-with-methods to be stored in database, test compiled and included in generated units. - - Snippets from both the user and main databases can now be duplicated. Duplicates are editable and are stored in the user database. - - Online CodeSnip FAQs can now be displayed in the default browser from a new option on the "Help" menu. -+ User interface changes: - - New "Snippets" and "Categories" top level menus have been added. They are populated with items previously on the "Database" menu. "Snippets" menu also has new "Duplicate Snippet" item. - - "Help" menu re-arranged: items from the former "On The Web" sub-menu are now placed directly on "Help" menu. - - Numerous new and updated glyphs on toolbar, menu and in main display. - - Minor tweaks to controls in the Code tab of the Snippets Editor. - - Minor changes to the style of version info displayed on the splash screen. -+ Bug fixes: - - Fixed potential source of a bug in code that edits user-defined categories. - - Fixed unreported minor bug in dialogue boxes that display tabbed page controls: clicking a tab did not always give it the keyboard focus. - - Fixed bug #3519784 ~~(http://bit.ly/IsCsun)~~ where multi-line "type" or "constant" snippets that start on the same line as the type or const keyword were corrupted when included in units using the "comments after snippet header" comment style. -+ Characters used to introduced switches on the command line were changed: '/' replaces '\'. '-' is still permitted. -+ User and main database formats modified. User databases saved with this version may not be readable with release 4.0 alpha 1. -+ Some refactoring. -+ Help file updated in line with changes and some errors fixed. -+ Updated documentation. - +Internal CodeSnip version 3.98.2 + +* New features: + * New "unit" snippet type that enables complete units to be stored in database and to be test compiled. + * New "classes" snippet type that enables a single Object Pascal class or advanced record-with-methods to be stored in database, test compiled and included in generated units. + * Snippets from both the user and main databases can now be duplicated. Duplicates are editable and are stored in the user database. + * Online CodeSnip FAQs can now be displayed in the default browser from a new option on the "Help" menu. +* User interface changes: + * New "Snippets" and "Categories" top level menus have been added. They are populated with items previously on the "Database" menu. "Snippets" menu also has new "Duplicate Snippet" item. + * "Help" menu re-arranged: items from the former "On The Web" sub-menu are now placed directly on "Help" menu. + * Numerous new and updated glyphs on toolbar, menu and in main display. + * Minor tweaks to controls in the Code tab of the Snippets Editor. + * Minor changes to the style of version info displayed on the splash screen. +* Bug fixes: + * Fixed potential source of a bug in code that edits user-defined categories. + * Fixed unreported minor bug in dialogue boxes that display tabbed page controls: clicking a tab did not always give it the keyboard focus. + * Fixed [SourceForge] bug #3519784 where multi-line "type" or "constant" snippets that start on the same line as the type or const keyword were corrupted when included in units using the "comments after snippet header" comment style. +* Characters used to introduced switches on the command line were changed: '/' replaces '\'. '-' is still permitted. +* User and main database formats modified. User databases saved with this version may not be readable with release 4.0 alpha 1. +* Some refactoring. +* Help file updated in line with changes and some errors fixed. +* Updated documentation. ## Release v4.0 alpha 1 (preview) of 31 December 2011 -_Internal CodeSnip version 3.98.1_ +Internal CodeSnip version 3.98.1 **Changes relate to v3.9.3:** CodeSnip 4 development branched off CodeSnip 3.9.3. CodeSnip v3 continued to be developed in parallel. -+ User interface changes: - - New multi-tab detail pane can now show more than one snippet, category etc. - - Results of test compiles now appear in a dialogue box instead of in details pane. - - New code import wizard for cleaner control over import process. - - New "Compile" top level menu that groups all actions relating to test compilation. - - Empty section headings can now be displayed in overview pane if required. - - New display options relating to multi-tab display. - - New view displayed instead of welcome screen when database updated. - - Some additions and changes to main window navigation keys. - - Main window and task bar captions changed. - - Some dialogue boxes tweaked. - - Compiler configuration dialogue box heavily revised to support default compiler paths. - - "About" dialogue box paths tab display improved. - - Compile error dialogue box display standardised. - - Splash screen updated. -+ Improved Delphi code syntax highlighter: - - Recognises Delphi 2010 keywords - - Correctly handles context sensitive directives within "property", "exports" and "external" statements. - - Recognises `&` prefix that causes keywords to be treated as identifiers. -+ Compiler search paths can now be specified for included units permitting non-VCL units to be used by snippets. -+ Database: - - Non-empty categories can no longer be deleted. - - File format of both user-defined and main databases changed. - - Database locations changed: updates to main database and edits to user database do not affect databases used by v3 and earlier. - - Location and file format of both user defined and main databases changed. - - Database now supports Unicode Delphi source code. - - Unicode Delphi identifiers can now be used for snippet names. - - Export and backup file formats updated: new formats are not backward compatible but older versions can still be imported. - - Code submission service now supports Unicode source code. - - Database updates now use v5 of delphidabbler.com web update service with revised checksum handling. -+ Unicode support: - - Program now fully supports Unicode internally. - - Test units now use UTF-8 format if source code contains non-ANSI characters. ANSI format is used otherwise to permit compilation on older Delphi compilers. - - Many export file formats now support Unicode and UTF8 formats. User may specify file types from Save dialogue box. - - Configuration files are now in Unicode format. - - Some Unicode support added to database (see above). -+ Web service data handling code improved: now includes ability to send raw bytes and can detect and adapt to character encoding used in responses. -+ Common and per-user configuration file names and locations changed. Bumped file version numbers to 6 and 8 respectively. -+ Fixed some bugs: - - Various Unicode and code page related problems in RTF code generation. - - Memory leaks. - - Version detection in backup file restoration. -+ Cascading style sheet handling improved. -+ Any errors in scripts run in browser control now trapped and reported as exceptions instead of via browser control's own error dialogue box. -+ Revised external object that communicates with JavaScript in browser controls. -+ Hyper-links used in snippets now support the https:// protocol. -+ A default title now used in print spooler if none specified. -+ Source code heavily refactored. -+ Help file updated in line with changes. -+ Installer: - - Changed so that v3 and v4 installs can co-exist - default install locations are different and v4 does not overwrite v3. - - Converts v3 configuration files to v4 Unicode format and copies to new locations. File version stamps are updated. - - Installer is now compiled with Unicode version of Inno Setup instead of ANSI version. - - Scripts updated and refactored. -+ Updated documentation, including changes to privacy statement and new file format documentation. - +* User interface changes: + * New multi-tab detail pane can now show more than one snippet, category etc. + * Results of test compiles now appear in a dialogue box instead of in details pane. + * New code import wizard for cleaner control over import process. + * New "Compile" top level menu that groups all actions relating to test compilation. + * Empty section headings can now be displayed in overview pane if required. + * New display options relating to multi-tab display. + * New view displayed instead of welcome screen when database updated. + * Some additions and changes to main window navigation keys. + * Main window and task bar captions changed. + * Some dialogue boxes tweaked. + * Compiler configuration dialogue box heavily revised to support default compiler paths. + * "About" dialogue box paths tab display improved. + * Compile error dialogue box display standardised. + * Splash screen updated. +* Improved Delphi code syntax highlighter: + * Recognises Delphi 2010 keywords + * Correctly handles context sensitive directives within "property", "exports" and "external" statements. + * Recognises `&` prefix that causes keywords to be treated as identifiers. +* Compiler search paths can now be specified for included units permitting non-VCL units to be used by snippets. +* Database: + * Non-empty categories can no longer be deleted. + * File format of both user-defined and main databases changed. + * Database locations changed: updates to main database and edits to user database do not affect databases used by v3 and earlier. + * Location and file format of both user defined and main databases changed. + * Database now supports Unicode Delphi source code. + * Unicode Delphi identifiers can now be used for snippet names. + * Export and backup file formats updated: new formats are not backward compatible but older versions can still be imported. + * Code submission service now supports Unicode source code. + * Database updates now use v5 of delphidabbler.com web update service with revised checksum handling. +* Unicode support: + * Program now fully supports Unicode internally. + * Test units now use UTF-8 format if source code contains non-ANSI characters. ANSI format is used otherwise to permit compilation on older Delphi compilers. + * Many export file formats now support Unicode and UTF8 formats. User may specify file types from Save dialogue box. + * Configuration files are now in Unicode format. + * Some Unicode support added to database (see above). +* Web service data handling code improved: now includes ability to send raw bytes and can detect and adapt to character encoding used in responses. +* Common and per-user configuration file names and locations changed. Bumped file version numbers to 6 and 8 respectively. +* Fixed some bugs: + * Various Unicode and code page related problems in RTF code generation. + * Memory leaks. + * Version detection in backup file restoration. +* Cascading style sheet handling improved. +* Any errors in scripts run in browser control now trapped and reported as exceptions instead of via browser control's own error dialogue box. +* Revised external object that communicates with JavaScript in browser controls. +* Hyper-links used in snippets now support the https:// protocol. +* A default title now used in print spooler if none specified. +* Source code heavily refactored. +* Help file updated in line with changes. +* Installer: + * Changed so that v3 and v4 installs can co-exist - default install locations are different and v4 does not overwrite v3. + * Converts v3 configuration files to v4 Unicode format and copies to new locations. File version stamps are updated. + * Installer is now compiled with Unicode version of Inno Setup instead of ANSI version. + * Scripts updated and refactored. +* Updated documentation, including changes to privacy statement and new file format documentation. ## Release v3.13.2 of 31 October 2013 -+ Modified Syntax Highlighter tab of Preferences dialogue box so that "vertical" fonts (whose names begin with "@") no longer appear in list of available fonts. -+ Fixed potential bug in operating system detection code that may fail on Windows 2000. -+ Fixed registry access code so that the 64 bit view of the registry is used when CodeSnip runs on a Windows 64 bit operating system. - +* Modified Syntax Highlighter tab of Preferences dialogue box so that "vertical" fonts (whose names begin with "@") no longer appear in list of available fonts. +* Fixed potential bug in operating system detection code that may fail on Windows 2000. +* Fixed registry access code so that the 64 bit view of the registry is used when CodeSnip runs on a Windows 64 bit operating system. ## Release v3.13.1 of 18 September 2013 -+ Removed File | Page Setup menu option because some settings made there were being ignored when a file was printed. This is a fix for bug #89 "Setup selections not being remembered" ~~(http://bit.ly/1a3V94x)~~. -+ Updated help file re changes. - +* Removed File | Page Setup menu option because some settings made there were being ignored when a file was printed. This is a fix for [SourceForge] bug #89 "Setup selections not being remembered". +* Updated help file re changes. ## Release v3.13.0 of 12 September 2013 -+ Added support for Delphi XE5 compiler. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for Delphi XE5 compiler. +* Updated documentation re changes. +* Updated help file re changes. ## Release v3.12.1 of 01 July 2013 -+ Fixed bug #82 "Fatal divide by zero exception on start-up" ~~(http://bit.ly/15aIJqQ)~~ that affected all v3.x versions when the IE 10 browser was installed. -+ Fixed unreported bug where IE 10 browser was being reported as IE 9. -+ Updated all third party DelphiDabbler code to latest available versions. -+ Updated documentation re changes. +* Fixed [SourceForge] bug #82 "Fatal divide by zero exception on start-up" that affected all v3.x versions when the IE 10 browser was installed. +* Fixed unreported bug where IE 10 browser was being reported as IE 9. +* Updated all third party DelphiDabbler code to latest available versions. +* Updated documentation re changes. ## Release v3.12.0 of 02 May 2013 -+ Added support for Delphi XE4 compiler. Implements feature request #78 ~~(http://bit.ly/10uGhoD)~~. -+ Fixed bug #78 ~~(http://bit.ly/ZQl3T4)~~ - CodeSnip doesn't restore window in correct position when task bar on left or top of screen. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for Delphi XE4 compiler. Implements [SourceForge] feature request #78. +* Fixed [SourceForge] bug #78: CodeSnip doesn't restore window in correct position when task bar on left or top of screen. +* Updated documentation re changes. +* Updated help file re changes. ## Release v3.11.1 of 08 December 2012 -+ Fixed bug #3578654 ~~(http://bit.ly/T7fTxu)~~: "Pre-processor directive errors in main db ini files" by removing support for problematic directives. -+ Hints are no longer displayed in status bar when user rolls mouse over a link in the display pane. This fixes bug #3577408 ~~(http://bit.ly/WEzZGg)~~: "Clicking detail pane snippet link leaves hint in status bar". -+ Windows no longer scale automatically when screen DPI differs from that on design system. This fixes bugs #3591818 ~~(http://bit.ly/TvNaUL)~~ "Strange window behaviour in Windows 7" and bug #3591820 ~~(http://bit.ly/SEH6dO)~~ "Incorrect font size used for some bold text". -+ Updated operating system detection code to detect Windows 8 & 2012 server. -+ Updated documentation - +* Fixed [SourceForge] bug #3578654: "Pre-processor directive errors in main db ini files" by removing support for problematic directives. +* Hints are no longer displayed in status bar when user rolls mouse over a link in the display pane. This fixes [SourceForge] bug #3577408: "Clicking detail pane snippet link leaves hint in status bar". +* Windows no longer scale automatically when screen DPI differs from that on design system. This fixes [SourceForge] bug #3591818: "Strange window behaviour in Windows 7" and [SourceForge] bug #3591820: "Incorrect font size used for some bold text". +* Updated operating system detection code to detect Windows 8 & 2012 server. +* Updated documentation ## Release v3.11.0 of 17 September 2012 -+ Added support for Delphi XE3 compiler. Implements feature request #3566345 ~~(http://bit.ly/OvbBPp)~~. -+ Bug fixes: - - #3561713 ~~(http://bit.ly/QEYRFx)~~: The Category view in the Overview pane sometimes appears fully expanded when it is expected to be fully collapsed. - - #3566430 ~~(http://bit.ly/U1KnGZ)~~: About Box Paths Page displays wrongly when themes not available. -+ Updated documentation re changes. -+ Updated help file re changes. - +* Added support for Delphi XE3 compiler. Implements [SourceForge] feature request #3566345. +* [SourceForge] Bug fixes: + * #3561713: The Category view in the Overview pane sometimes appears fully expanded when it is expected to be fully collapsed. + * #3566430: About Box Paths Page displays wrongly when themes not available. +* Updated documentation re changes. +* Updated help file re changes. ## Release v3.10.5 of 21 August 2012 -+ Fixed bugs: - - #3559257 ~~(http://bit.ly/Qc8Fqu)~~: Compile Results accessed from menu can get out of sync. - - #3559156 ~~(http://bit.ly/TKXYQ7)~~: "Previews" disappearing in Preferences dialogue box - +* Fixed [SourceForge] bugs: + * #3559257: Compile Results accessed from menu can get out of sync. + * #3559156: "Previews" disappearing in Preferences dialogue box ## Release v3.10.4 of 16 August 2012 -+ Added support for displaying pop-up menus over appropriate control when Alt+F10 is pressed. Fixes bug #3556713 ~~(http://bit.ly/RIzfvQ)~~. -+ Changes to snippets editor: - - Added missing edit context menu to "add unit" edit control on References tab. Fixes bug #3556718 ~~(http://bit.ly/RVanCE~~) as it relates to v3. - - Predefined list of units in Units list on References tab now includes the "Types" unit. - - Referenced unit names may now contain dots. - - Snippets Editor help topic now explains need to configure Delphi XE2 compiler to search namespaces containing referenced units. This provides a solution to bug #3536531 ~~(http://bit.ly/Q2bcmY)~~. - +* Added support for displaying pop-up menus over appropriate control when Alt+F10 is pressed. Fixes [SourceForge] bug #3556713. +* Changes to snippets editor: + * Added missing edit context menu to "add unit" edit control on References tab. Fixes [SourceForge] bug #3556718 as it relates to v3. + * Predefined list of units in Units list on References tab now includes the "Types" unit. + * Referenced unit names may now contain dots. + * Snippets Editor help topic now explains need to configure Delphi XE2 compiler to search namespaces containing referenced units. This provides a solution to [SourceForge] bug #3536531. ## Release v3.10.3 of 25 July 2012 -+ Changed so that Delphi compilers can be detected by examining current user registry key in addition to local machine registry key. This enables Delphis that were installed for a given user only to be detected. -+ Fixed bug in Compiler tab of Configure Compilers dialogue box that failed to flag selected compiler as unavailable after button was pressed. - +* Changed so that Delphi compilers can be detected by examining current user registry key in addition to local machine registry key. This enables Delphis that were installed for a given user only to be detected. +* Fixed bug in Compiler tab of Configure Compilers dialogue box that failed to flag selected compiler as unavailable after button was pressed. ## Release v3.10.2 of 19 June 2012 -+ Fixed bug #3536331 ~~(http://bit.ly/KQVATf)~~ where some distinct words in a snippet's Extra text where not being found in text searches. -+ Info about user's OS and IE version is now sent to web server during online database updates. -+ Updated privacy statement re changes in information sent by update web service. - +* Fixed [SourceForge] bug #3536331 where some distinct words in a snippet's Extra text where not being found in text searches. +* Info about user's OS and IE version is now sent to web server during online database updates. +* Updated privacy statement re changes in information sent by update web service. ## Release v3.10.1 of 20 April 2012 -+ Fixed bug #3519784 ~~(http://bit.ly/IsCsun)~~ where multi-line type or constant snippets that start on same line as type or const keyword were corrupted when included in units using the "comments after snippet header" comment style. -+ Also fixed potential source of a bug in code that edits user-defined categories. - +* Fixed [SourceForge] bug #3519784 where multi-line type or constant snippets that start on same line as type or const keyword were corrupted when included in units using the "comments after snippet header" comment style. +* Also fixed potential source of a bug in code that edits user-defined categories. ## Release v3.10.0 of 17 April 2012 -+ Added new Help | On The Web | FAQs menu option to display CodeSnip FAQs in default browser. -+ Fixed unreported minor bug in dialogue boxes that display tabbed page controls: clicking a tab did not always give it the keyboard focus. -+ Characters used to introduced switches on command line were changed: '/' replaces non-standard '\'. '-' is still permitted. -+ Updated help file: added topic for new menu option and minor change to FAQ help topic. - +* Added new Help | On The Web | FAQs menu option to display CodeSnip FAQs in default browser. +* Fixed unreported minor bug in dialogue boxes that display tabbed page controls: clicking a tab did not always give it the keyboard focus. +* Characters used to introduced switches on command line were changed: '/' replaces non-standard '\'. '-' is still permitted. +* Updated help file: added topic for new menu option and minor change to FAQ help topic. ## Release v3.9.3 of 23 November 2011 **Note:** Development of CodeSnip 4 branched off this release. -+ Fixed some bugs in main window: - - Toolbar was truncated when window is too narrow to display it all. It now wraps. - - Treeview state in Overview pane was not restoring correctly after navigating away from and then returning to a tab. - - Pressing Ctrl+Tab or Shift+Ctrl+Tab did not necessarily change the tab in the expected tab set in either the Overview or Detail panes. -+ Fixed a broken URL in about box. -+ Bumped installer program helper build number re Delphi 2010 compilation (should have been done at v3.5.1). - +* Fixed some bugs in main window: + * Toolbar was truncated when window is too narrow to display it all. It now wraps. + * Treeview state in Overview pane was not restoring correctly after navigating away from and then returning to a tab. + * Pressing Ctrl+Tab or Shift+Ctrl+Tab did not necessarily change the tab in the expected tab set in either the Overview or Detail panes. +* Fixed a broken URL in about box. +* Bumped installer program helper build number re Delphi 2010 compilation (should have been done at v3.5.1). ## Release v3.9.2 of 28 October 2011 -+ Fixed bug #3427741 ~~(http://bit.ly/vq2fAz)~~ where details pane tabs didn't change in response to key presses. -+ Fixed bug #3427866 ~~(http://bit.ly/w31z8L)~~ where selection in overview was not always same as item displayed in details pane. -+ Fixed bug #3427889 ~~(http://bit.ly/tijnmF)~~ where there was the possibility of a GPF in overview pane. - +* Fixed [SourceForge] bug #3427741 where details pane tabs didn't change in response to key presses. +* Fixed [SourceForge] bug #3427866 where selection in overview was not always same as item displayed in details pane. +* Fixed [SourceForge] bug #3427889 where there was the possibility of a GPF in overview pane. ## Release v3.9.1 of 18 September 2011 -+ Fixed bug #3369422 ~~(http://bit.ly/omSp6F)~~ in Pascal highlighter that was causing an assertion failure when parsing malformed Pascal general format floating point numbers. - +* Fixed [SourceForge] bug #3369422 in Pascal highlighter that was causing an assertion failure when parsing malformed Pascal general format floating point numbers. ## Release v3.9.0 of 07 September 2011 -+ Added support for Delphi XE2 Windows 32 bit compiler: - - Can now test compile and display results with Delphi XE2 32 bit. - - Delphi XE2 compiler version 23.0 has been added to the drop down menu in the Code Generation tab of the preference dialogue box. - - Updated help file re Delphi XE2 support. - - Updated documentation. -+ Limited user name edit control to 48 chars in registration wizard because this is limit in online registration database. - +* Added support for Delphi XE2 Windows 32 bit compiler: + * Can now test compile and display results with Delphi XE2 32 bit. + * Delphi XE2 compiler version 23.0 has been added to the drop down menu in the Code Generation tab of the preference dialogue box. + * Updated help file re Delphi XE2 support. + * Updated documentation. +* Limited user name edit control to 48 chars in registration wizard because this is limit in online registration database. ## Release v3.8.11 of 02 July 2011 -+ Fixed display problem in about box and compiler error dialogue boxes on systems using Internet Explorer v9 web browser control. This fixes issue #3349186 ~~(http://bit.ly/lF6bTO)~~. -+ Updated read-me file re support for IE9 browser control. - +* Fixed display problem in about box and compiler error dialogue boxes on systems using Internet Explorer v9 web browser control. This fixes [SourceForge] issue #3349186. +* Updated read-me file re support for IE9 browser control. ## Release v3.8.10 of 20 May 2011 -+ Reverted checked tree views and list boxes to standard Windows behaviour. Clicking item text no longer toggles associated check boxes. This behaviour was more problematic then helpful. -+ Updated documentation, including new info about CodeSnip FAQ. -+ Added FAQs topic and TOC entry to help file that links to online FAQ. - +* Reverted checked tree views and list boxes to standard Windows behaviour. Clicking item text no longer toggles associated check boxes. This behaviour was more problematic then helpful. +* Updated documentation, including new info about CodeSnip FAQ. +* Added FAQs topic and TOC entry to help file that links to online FAQ. ## Release v3.8.9 of 10 May 2011 -+ Fixed bug #3299870 ~~(http://bit.ly/iX8Its)~~ that was allowing imported snippets with duplicate names to be renamed with invalid names. -+ Improved UI used to edit imported snippet names. -+ Any "warning" compile results in main database are now treated and displayed as "success" results per feature request #3290359 ~~(http://bit.ly/mshbRa)~~. -+ Fixed unreported potential bug in code that sets window class names. -+ Updated documentation. - +* Fixed [SourceForge] bug #3299870 that was allowing imported snippets with duplicate names to be renamed with invalid names. +* Improved UI used to edit imported snippet names. +* Any "warning" compile results in main database are now treated and displayed as "success" results per [SourceForge] feature request #3290359. +* Fixed unreported potential bug in code that sets window class names. +* Updated documentation. ## Release v3.8.8 of 19 January 2011 -+ Added facility for user to specify maximum age of news items displayed in news dialogue box. New preferences tab added where the maximum age can be customised. -+ Preferences dialogue box now displays multi-line tabs when necessary. -+ Refactored some code used to align controls on forms. -+ Updated license. License HTML help file is no longer MPLd and may not be altered by third parties. -+ Updated help file re changes. -+ Updated documentation. - +* Added facility for user to specify maximum age of news items displayed in news dialogue box. New preferences tab added where the maximum age can be customised. +* Preferences dialogue box now displays multi-line tabs when necessary. +* Refactored some code used to align controls on forms. +* Updated license. License HTML help file is no longer MPLd and may not be altered by third parties. +* Updated help file re changes. +* Updated documentation. ## Release v3.8.7 of 16 December 2010 -+ Delphi XE compiler version 22.0 has been added to the drop down menu in the Code Generation tab of the preference dialogue box. -+ Bug fix: compiler results are no longer listed when free-form snippets are printed or copied to the clipboard using the "Edit | Copy Information" menu item. - +* Delphi XE compiler version 22.0 has been added to the drop down menu in the Code Generation tab of the preference dialogue box. +* Bug fix: compiler results are no longer listed when free-form snippets are printed or copied to the clipboard using the "Edit | Copy Information" menu item. ## Release v3.8.6 of 06 December 2010 -+ Bug fix release (none reported in bug tracker): - - Corrected XML file validation so that it does not reject XML processing instructions that contain an "encoding" attribute. - - Fixed long standing bug that was crashing CodeSnip when the database was updated or restored after editing, adding or deleting any user defined snippet. - - Attempting to restore a database backup with an unknown (later) file format now raises an exception. Previously CodeSnip tried, unsuccessfully, to read the file. - +* Bug fix release (none reported in bug tracker): + * Corrected XML file validation so that it does not reject XML processing instructions that contain an "encoding" attribute. + * Fixed long standing bug that was crashing CodeSnip when the database was updated or restored after editing, adding or deleting any user defined snippet. + * Attempting to restore a database backup with an unknown (later) file format now raises an exception. Previously CodeSnip tried, unsuccessfully, to read the file. ## Release v3.8.5 of 28 November 2010 -+ Fixed bug where user was able to create snippets with valid names that would crash the alphabetic overview. Snippet names are now limited to letters from English alphabet and the underscore. Fixes bug #3120958 ~~(http://bit.ly/fDAswL)~~. -+ Fixed bug where snippets that have names beginning with a lower case letter were being omitted from from the associated list of snippets shown in the detail pane. Fixes bug #3120962 ~~(http://bit.ly/eGhQvc)~~. -+ Updated Snippets Editor topic in help file. - +* Fixed bug where user was able to create snippets with valid names that would crash the alphabetic overview. Snippet names are now limited to letters from English alphabet and the underscore. Fixes [SourceForge] bug #3120958. +* Fixed bug where snippets that have names beginning with a lower case letter were being omitted from from the associated list of snippets shown in the detail pane. Fixes [SourceForge] bug #3120962. +* Updated Snippets Editor topic in help file. ## Release v3.8.4 of 26 November 2010 -+ User can now opt to terminate the application when an unexpected exception is trapped. This implements feature request #3074914 ~~(http://bit.ly/hUyEAw)~~. -+ Wording of bug report dialogue boxes changed. -+ Snippets selection dialogue box now displays wait cursor while waiting for it to be displayed. -+ Some corrections and clarifications made to comments that appear in generated "include" files. -+ Custom message boxes can now display custom title and icon. -+ Imported some updates from "new-backend" development tree: - - Some source code re-organisation and renaming. - - Updated some sorted list management code. - +* User can now opt to terminate the application when an unexpected exception is trapped. This implements [SourceForge] feature request #3074914. +* Wording of bug report dialogue boxes changed. +* Snippets selection dialogue box now displays wait cursor while waiting for it to be displayed. +* Some corrections and clarifications made to comments that appear in generated "include" files. +* Custom message boxes can now display custom title and icon. +* Imported some updates from "new-backend" development tree: + * Some source code re-organisation and renaming. + * Updated some sorted list management code. ## Release v3.8.3 of 24 November 2010 -+ Added button to "Compile" tab of Snippets Editor to display unit used to test compile snippets. This implements feature request #3108008 ~~(http://bit.ly/elBZnn)~~. -+ Fixed unreported bugs in handling of exceptions raised in threads. -+ Simplified method used to load database on start up. No longer uses a separate thread. -+ Overhauled and simplified code used to display "wait" dialogues during test compilations and database reloading. -+ Refactorings: - - Increased use of generics in lists and enumerators. - - Reorganised source code tree by moving some code to more relevant units, renaming some units and increasing use of namespaces. - - Removed some redundant code. -+ Updated help file re changes to snippets editor. - +* Added button to "Compile" tab of Snippets Editor to display unit used to test compile snippets. This implements [SourceForge] feature request #3108008. +* Fixed unreported bugs in handling of exceptions raised in threads. +* Simplified method used to load database on start up. No longer uses a separate thread. +* Overhauled and simplified code used to display "wait" dialogues during test compilations and database reloading. +* Refactorings: + * Increased use of generics in lists and enumerators. + * Reorganised source code tree by moving some code to more relevant units, renaming some units and increasing use of namespaces. + * Removed some redundant code. +* Updated help file re changes to snippets editor. ## Release v3.8.2 of 16 November 2010 -+ The position of the caret in the Snippets Editor's Extra Information control is now displayed. Implements feature request #3105288 ~~(http://bit.ly/bRV86Z)~~. -+ Code that displays caret positions was refactored and improved. -+ Display of errors in the Snippets Editor's text edit controls has been improved in most cases either by positioning the caret near the error or selecting the erroneous text. This implements feature request #3107042 ~~(http://bit.ly/cKx5YQ)~~. -+ Made significant changes to code that parses REML mark-up: - - Rationalised error reporting and added support for reporting the position of errors. - - Fixed unreported bug that produced wrong error message when empty tags are encountered. - - Fixed bug #3107982 ~~(http://bit.ly/cp9Cff)~~ that failed to report some unclosed tags as errors. - - Refactored and reorganised much of the code. -+ All encoding and decoding of URIs is now RFC 3986 compliant. -+ Refactored character detection and string encoding support code. -+ Renamed some units and classes. -+ Updated documentation. - +* The position of the caret in the Snippets Editor's Extra Information control is now displayed. Implements [SourceForge] feature request #3105288. +* Code that displays caret positions was refactored and improved. +* Display of errors in the Snippets Editor's text edit controls has been improved in most cases either by positioning the caret near the error or selecting the erroneous text. This implements [SourceForge] feature request #3107042. +* Made significant changes to code that parses REML mark-up: + * Rationalised error reporting and added support for reporting the position of errors. + * Fixed unreported bug that produced wrong error message when empty tags are encountered. + * Fixed [SourceForge] bug #3107982 that failed to report some unclosed tags as errors. + * Refactored and reorganised much of the code. +* All encoding and decoding of URIs is now RFC 3986 compliant. +* Refactored character detection and string encoding support code. +* Renamed some units and classes. +* Updated documentation. ## Release v3.8.1 of 08 November 2010 -+ Fixed bug #3015589 ~~(http://bit.ly/cdPedH)~~ where some user syntax highlighter settings were being ignored in main display. -+ Changed Test Unit view dialogue box to use user syntax highlighter settings. -+ Revised credits in About Box program tab. -+ Updated third party units: PJMD5 to v0.3, PJSysInfo to v3.3, PJVersionInfo to v3.3. -+ Modified version info code to use new features of new PJVersionInfo 3rd party unit. -+ Refactored code that parses XHTML-style code. -+ Updated compiler warnings used in project and made command line and IDE options the same. -+ Updated documentation. - +* Fixed [SourceForge] bug #3015589 where some user syntax highlighter settings were being ignored in main display. +* Changed Test Unit view dialogue box to use user syntax highlighter settings. +* Revised credits in About Box program tab. +* Updated third party units: PJMD5 to v0.3, PJSysInfo to v3.3, PJVersionInfo to v3.3. +* Modified version info code to use new features of new PJVersionInfo 3rd party unit. +* Refactored code that parses XHTML-style code. +* Updated compiler warnings used in project and made command line and IDE options the same. +* Updated documentation. ## Release v3.8.0 of 23 October 2010 -+ Added support for Delphi XE to program. Can now test compile and display results with Delphi XE. -+ Updated help file re Delphi XE support. -+ Some refactoring. -+ Standardised bug-trap and assertion failure exception messages. - +* Added support for Delphi XE to program. Can now test compile and display results with Delphi XE. +* Updated help file re Delphi XE support. +* Some refactoring. +* Standardised bug-trap and assertion failure exception messages. ## Release v3.7.0 of 23 September 2010 -+ Added new "Help | CodeSnip News" menu option that displays latest news about CodeSnip and the online database in a dialogue box. The news comes from the CodeSnip RSS news feed. -+ Removed news pane from "Update from Web" dialogue box and replaced with button that displays new "CodeSnip News" dialogue box. -+ Removed mailing list subscription facility: - - Removed subscription dialogue box and associated menu option. - - Removed code that accessed mailing list web service. - - Removed subscription option from program registration dialogue box. -+ Fixed a memory leak. -+ Added code that downloads XML document and reads and parses RSS feeds. -+ Refactored and improved HTTP request handling code. -+ Some further refactoring. -+ Updated help file re changes in this release. -+ Updated privacy statement. - +* Added new "Help | CodeSnip News" menu option that displays latest news about CodeSnip and the online database in a dialogue box. The news comes from the CodeSnip RSS news feed. +* Removed news pane from "Update from Web" dialogue box and replaced with button that displays new "CodeSnip News" dialogue box. +* Removed mailing list subscription facility: + * Removed subscription dialogue box and associated menu option. + * Removed code that accessed mailing list web service. + * Removed subscription option from program registration dialogue box. +* Fixed a memory leak. +* Added code that downloads XML document and reads and parses RSS feeds. +* Refactored and improved HTTP request handling code. +* Some further refactoring. +* Updated help file re changes in this release. +* Updated privacy statement. ## Release v3.6.3 of 22 July 2010 -+ Completely overhauled code that interacts with web services. - - Character encodings are now correctly handled per information in HTTP header and several different encodings are supported. - - MD5 checksums in HTTP headers are now supported. -+ Updated and corrected the contents of the About Box's "About The Program" Tab. -+ Some refactorings, mainly to code that uses MD5 message digests. -+ Attempts to compile source with Delphi 2009 and earlier are now prevented. -+ Updated documentation. - +* Completely overhauled code that interacts with web services. + * Character encodings are now correctly handled per information in HTTP header and several different encodings are supported. + * MD5 checksums in HTTP headers are now supported. +* Updated and corrected the contents of the About Box's "About The Program" Tab. +* Some refactorings, mainly to code that uses MD5 message digests. +* Attempts to compile source with Delphi 2009 and earlier are now prevented. +* Updated documentation. ## Release v3.6.2 of 18 June 2010 -+ Fixed source code formatting problem in code generator where "forward" declarations were sometimes preceded with an unwanted blank line. -+ Fixed potential bug in code that parses mark-up used for a snippet's Extra information. Symbolic entities were not case sensitive. -+ Fixed a memory leak. -+ Some refactorings that increase use of generics and some others. -+ Read-me file updated re v3.6.1 password changes. - +* Fixed source code formatting problem in code generator where "forward" declarations were sometimes preceded with an unwanted blank line. +* Fixed potential bug in code that parses mark-up used for a snippet's Extra information. Symbolic entities were not case sensitive. +* Fixed a memory leak. +* Some refactorings that increase use of generics and some others. +* Read-me file updated re v3.6.1 password changes. ## Release v3.6.1 of 01 June 2010 -+ Proxy server passwords can now contain any Unicode character, not just those included in the Windows-1252 code page. -+ Password format in per user ini file changed. Existing passwords have to be re-entered. Ini file format updated to v7. -+ Installer updated: - - It deletes any passwords from v6 and earlier per user ini files. - - Per-user ini file now stamped as v7. -+ Some potential Unicode-ANSI string conversion problems fixed. -+ Updated documentation. - +* Proxy server passwords can now contain any Unicode character, not just those included in the Windows-1252 code page. +* Password format in per user ini file changed. Existing passwords have to be re-entered. Ini file format updated to v7. +* Installer updated: + * It deletes any passwords from v6 and earlier per user ini files. + * Per-user ini file now stamped as v7. +* Some potential Unicode-ANSI string conversion problems fixed. +* Updated documentation. ## Release v3.6.0 of 26 May 2010 -+ Added support for emitting compiler directives to switch off specified warnings. This implement feature request #2994485 ~~(see http://bit.ly/cxDJG4)~~. -+ Preferences dialogue box updated: - - New "Code Generation" tab used to configure which if any warnings are to be inhibited. - - Renamed "Source Code" tab to "Code Formatting". -+ Added new tab to About Box that displays and enables exploration of some key directories used by CodeSnip. -+ Snippets editor now displays row and column occupied by text cursor. -+ Per user ini file format changed. It now supports code generation preferences. Ini file version updated to v6. -+ Installer updated: - - Ini files are stamped with correct program and ini file version information. - - Older versions (v1..v5) of per-user ini file are updated with default code generation preferences. - - Per-user ini file now stamped as v6. -+ Fixed numerous memory leaks. -+ Fixed some other potential and unreported minor bugs. -+ Some refactoring. -+ Updated help file re changes. - +* Added support for emitting compiler directives to switch off specified warnings. This implement [SourceForge] feature request #2994485. +* Preferences dialogue box updated: + * New "Code Generation" tab used to configure which if any warnings are to be inhibited. + * Renamed "Source Code" tab to "Code Formatting". +* Added new tab to About Box that displays and enables exploration of some key directories used by CodeSnip. +* Snippets editor now displays row and column occupied by text cursor. +* Per user ini file format changed. It now supports code generation preferences. Ini file version updated to v6. +* Installer updated: + * Ini files are stamped with correct program and ini file version information. + * Older versions (v1..v5) of per-user ini file are updated with default code generation preferences. + * Per-user ini file now stamped as v6. +* Fixed numerous memory leaks. +* Fixed some other potential and unreported minor bugs. +* Some refactoring. +* Updated help file re changes. ## Release v3.5.5 of 24 March 2010 -+ Fixes download stream read bug #2976048 ~~(see http://bit.ly/ds6mBr)~~. - +* Fixes download stream read [SourceForge] bug #2976048. ## Release v3.5.4 of 18 March 2010 -+ Temporary fix for download error checking bug #2970055 ~~(see http://bit.ly/cvf9Mm)~~. -+ Fixed https protocol bug #2970896 ~~(see http://bit.ly/bCIx38)~~. - +* Temporary fix for download error checking [SourceForge] bug #2970055. +* Fixed https protocol [SourceForge] bug #2970896. ## Release v3.5.3 of 08 March 2010 -+ Fixed database download error checking bug #2964767 ~~(see http://bit.ly/90vFfp)~~. -+ Updated PayPal donations narrative on welcome page. - +* Fixed database download error checking [SourceForge] bug #2964767. +* Updated PayPal donations narrative on welcome page. ## Release v3.5.2 of 22 February 2010 -+ Changed database downloader to: - - Use web service's revised download file format - - Validate download data before updating local database. - - Provide better download error messages. -+ Fixed bug #2947794 in view link dialogue box ~~(see http://bit.ly/beiZZ8)~~. -+ Refactored some exception handling code. - +* Changed database downloader to: + * Use web service's revised download file format + * Validate download data before updating local database. + * Provide better download error messages. +* Fixed [SourceForge] bug #2947794 in view link dialogue box. +* Refactored some exception handling code. ## Release v3.5.1 of 09 February 2010 -+ New Unicode build of the program compiled with Delphi 2010. File I/O remains ANSI. -+ Windows NT is no longer supported. Windows 2000 is now the minimum OS. Set-up program changed to enforce this. -+ More rigorous enforcement of rules for REML tag attributes used in a snippet's Extra information. -+ Fixed a couple of minor UI problems in the Proxy Server and Trapped Bug Report dialogue boxes. -+ Minor changes to HTML and embedded browser code. -+ Some refactoring. -+ Updated documentation. - +* New Unicode build of the program compiled with Delphi 2010. File I/O remains ANSI. +* Windows NT is no longer supported. Windows 2000 is now the minimum OS. Set-up program changed to enforce this. +* More rigorous enforcement of rules for REML tag attributes used in a snippet's Extra information. +* Fixed a couple of minor UI problems in the Proxy Server and Trapped Bug Report dialogue boxes. +* Minor changes to HTML and embedded browser code. +* Some refactoring. +* Updated documentation. ## Release v3.5.0 of 16 January 2010 -+ Overview pane can now be configured using Preferences dialogue box to start up with all sections collapsed. -+ Reference to ability to donate by credit / debit card removed from Donate dialogue box: now PayPal only. -+ Help file updated re above changes. -+ Minor refactoring of code that provides information about and renders source code comments. - +* Overview pane can now be configured using Preferences dialogue box to start up with all sections collapsed. +* Reference to ability to donate by credit / debit card removed from Donate dialogue box: now PayPal only. +* Help file updated re above changes. +* Minor refactoring of code that provides information about and renders source code comments. ## Release v3.4.8 of 10 January 2010 -+ Made some changes to key presses responded to by overview pane and fixed bug where Alt+F4 was not closing program when pane had focus. -+ Made some changes to hints displayed when rolling over links in compiler check pane. Also removed pop-up windows describing compiler errors. -+ Updated help file: noted Delphi 2010 compiler support and added new information about overview pane keyboard short-cuts. - +* Made some changes to key presses responded to by overview pane and fixed bug where Alt+F4 was not closing program when pane had focus. +* Made some changes to hints displayed when rolling over links in compiler check pane. Also removed pop-up windows describing compiler errors. +* Updated help file: noted Delphi 2010 compiler support and added new information about overview pane keyboard short-cuts. ## Release v3.4.7 of 31 December 2009 -+ Added IE version number to OS information submitted when program is registered. -+ Program now displays "[localhost]" in main window caption when started with -localhost switch. -+ All text edit controls in snippets editor now have custom pop-up menus and short-cuts for "cut", "copy", "paste", "select all" and "undo" now work. -+ Refactored code that supports use of fonts. -+ Updated privacy statement re registration changes. - +* Added IE version number to OS information submitted when program is registered. +* Program now displays "[localhost]" in main window caption when started with -localhost switch. +* All text edit controls in snippets editor now have custom pop-up menus and short-cuts for "cut", "copy", "paste", "select all" and "undo" now work. +* Refactored code that supports use of fonts. +* Updated privacy statement re registration changes. ## Release v3.4.6 of 18 November 2009 -+ Changed code that takes a security backup of main database during updates to store backup in a single file rather as separate files in a temporary folder. This should fix bug #2898687 ~~(see http://bit.ly/bKg6oH)~~. -+ Slightly modified user database backup file format to match that now used for main database backup. -+ Fixed potential bugs: - - Code that performs busy waits could have caused program to freeze. - - Negative numbers written to backup files were not being written correctly. - - A garbled error message was corrected. - +* Changed code that takes a security backup of main database during updates to store backup in a single file rather as separate files in a temporary folder. This should fix [SourceForge] bug #2898687. +* Slightly modified user database backup file format to match that now used for main database backup. +* Fixed potential bugs: + * Code that performs busy waits could have caused program to freeze. + * Negative numbers written to backup files were not being written correctly. + * A garbled error message was corrected. ## Release v3.4.5 of 09 November 2009 -+ Home, Ctrl+Home, End and Ctrl+End keys now work in overview pane and go to first and last item in tree view respectively per feature request #2888880 ~~(see http://bit.ly/bgJCVU)~~. -+ State of tree view in overview pane is now maintained after editing the user database: the tree is no longer always fully expanded after each edit. -+ Removed "Properties" button from print dialogue box along with associated dialogue boxes. This option has always been buggy. This "fixes" bug #2868706 ~~(see http://bit.ly/9LArqI)~~. -+ Fixed unreported makefile bug. - +* Home, Ctrl+Home, End and Ctrl+End keys now work in overview pane and go to first and last item in tree view respectively per [SourceForge] feature request #2888880. +* State of tree view in overview pane is now maintained after editing the user database: the tree is no longer always fully expanded after each edit. +* Removed "Properties" button from print dialogue box along with associated dialogue boxes. This option has always been buggy. This "fixes" [SourceForge] bug #2868706. +* Fixed unreported makefile bug. ## Release v3.4.4 of 21 October 2009 -+ Changed bug reporting mechanism. Bugs are now reported via the on-line bug tracker. Bug report dialogues changed accordingly. Access to the old bug report web service was removed. -+ Added two new default syntax highlighter styles: "Visual Studio" and "No Highlighter". The latter switches off syntax highlighting. -+ Fixed bug no. 2882331 ~~(see http://bit.ly/beArcC)~~. This was a bug in the syntax highlighter that occurred when an unexpected character was encountered. -+ Updated help file re changes. -+ Some minor source code corrections. - +* Changed bug reporting mechanism. Bugs are now reported via the on-line bug tracker. Bug report dialogues changed accordingly. Access to the old bug report web service was removed. +* Added two new default syntax highlighter styles: "Visual Studio" and "No Highlighter". The latter switches off syntax highlighting. +* Fixed [SourceForge] bug #2882331. This was a bug in the syntax highlighter that occurred when an unexpected character was encountered. +* Updated help file re changes. +* Some minor source code corrections. ## Release v3.4.3 of 19 October 2009 -+ User's OS is now reported and recorded when program is registered. -+ Text displayed in preview dialogue boxes can now be scrolled horizontally. -+ Added support for building source against later releases of Indy 10 components. -+ Help file and privacy statement updated. -+ Further updated third party GIF image handling code to latest release. -+ Some changes to source code project options. - +* User's OS is now reported and recorded when program is registered. +* Text displayed in preview dialogue boxes can now be scrolled horizontally. +* Added support for building source against later releases of Indy 10 components. +* Help file and privacy statement updated. +* Further updated third party GIF image handling code to latest release. +* Some changes to source code project options. ## Release v3.4.2 of 10 October 2009 -+ Fixed bugs #2868706 ~~(see http://bit.ly/9LArqI)~~ and #2875857 ~~(see http://bit.ly/bN4xqE)~~ -+ Updated GIF image handling code. - +* Fixed [SourceForge] bugs #2868706 and #2875857. +* Updated GIF image handling code. ## Release v3.4.1 of 29 September 2009 -+ All dialogue boxes that request a user's name and / or email address now remember the information last entered, to save retyping the same data. -+ Changed to use Indy Internet Components v10 instead of v9 for net access. -+ Refactored: - - Code that stores information about a user. - - Code that gets details of system folders on local system and other file system related code. -+ Updated privacy statement (text file and in help file). - +* All dialogue boxes that request a user's name and / or email address now remember the information last entered, to save retyping the same data. +* Changed to use Indy Internet Components v10 instead of v9 for net access. +* Refactored: + * Code that stores information about a user. + * Code that gets details of system folders on local system and other file system related code. +* Updated privacy statement (text file and in help file). ## Release v3.4 of 24 September 2009 -+ Added support for Delphi 2010 to program. Can now test compile and display results with Delphi 2010. -+ Bug fixes: - - "Invalid cast" error that occasionally appears when a snippet is updated. - - Bug that kept backup files locked open after restoring a database backup. - - Current selection is now displayed in Alphabetic and Snippet Kind tabs of overview pane: previously all the database was shown, regardless of search. - +* Added support for Delphi 2010 to program. Can now test compile and display results with Delphi 2010. +* Bug fixes: + * "Invalid cast" error that occasionally appears when a snippet is updated. + * Bug that kept backup files locked open after restoring a database backup. + * Current selection is now displayed in Alphabetic and Snippet Kind tabs of overview pane: previously all the database was shown, regardless of search. ## Release v3.3 of 21 September 2009 -+ Added support for user defined categories which can now be added, renamed or deleted. -+ Made changes to snippets editor: - - On the "Compile Results" Tab, a single simplified list box is now used to both display and change compile results. This replaces two linked controls. - - The text case of a snippet name can now be changed without causing a duplicate name error. - - Some controls resized. -+ Fixed bug where attempting to overwrite files that are in use caused the bug report dialogue box to appear instead of simply reporting the problem. -+ Improved validity checking of snippets that are included in generated source code. -+ Help file updated. -+ Refactored: - - UI handling code in snippets editor. - - Some Snippets database and validation code. - +* Added support for user defined categories which can now be added, renamed or deleted. +* Made changes to snippets editor: + * On the "Compile Results" Tab, a single simplified list box is now used to both display and change compile results. This replaces two linked controls. + * The text case of a snippet name can now be changed without causing a duplicate name error. + * Some controls resized. +* Fixed bug where attempting to overwrite files that are in use caused the bug report dialogue box to appear instead of simply reporting the problem. +* Improved validity checking of snippets that are included in generated source code. +* Help file updated. +* Refactored: + * UI handling code in snippets editor. + * Some Snippets database and validation code. ## Release v3.2.3 of 14 September 2009 -+ Fixed bug in "update from web" dialogue box where most up to date news item was not being displayed. -+ Dialogue boxes that that enable selection of categories and snippets by means of tree views and associated check boxes now sort categories by description. -+ Categories and snippet kinds displayed in the snippets editor are now sorted by description. -+ Refactored: - - Code that displays tree views in overview pane and snippet selection dialogues. - - Some list management code. - - Some snippets editor code. - +* Fixed bug in "update from web" dialogue box where most up to date news item was not being displayed. +* Dialogue boxes that that enable selection of categories and snippets by means of tree views and associated check boxes now sort categories by description. +* Categories and snippet kinds displayed in the snippets editor are now sorted by description. +* Refactored: + * Code that displays tree views in overview pane and snippet selection dialogues. + * Some list management code. + * Some snippets editor code. ## Release v3.2.2 of 08 September 2009 -+ Fixed bug in check list boxes where moving selection using keyboard causes check state to be toggled. -+ Custom colours used in colour dialogue, on syntax highlighter page of preferences dialogue box, are now persistent. -+ Re-implemented code that displays pop-up menus in detail pane, and fixed a minor glitch as a side effect. -+ Simplified code that manages help system. -+ Refactored code that manages and customises common dialogues. - +* Fixed bug in check list boxes where moving selection using keyboard causes check state to be toggled. +* Custom colours used in colour dialogue, on syntax highlighter page of preferences dialogue box, are now persistent. +* Re-implemented code that displays pop-up menus in detail pane, and fixed a minor glitch as a side effect. +* Simplified code that manages help system. +* Refactored code that manages and customises common dialogues. ## Release v3.2.1 of 24 August 2009 -+ Appearance of comments that appear at the top of generated source code was changed. -+ Slightly modified "license" that appears at the top of some generated units. -+ Information about contributor of imported code is now appended to snippet's "extra" information. -+ Added a garbage collector. -+ Changed size of About box - now wider and credits scroll boxes are now taller. Added credit for encryption code. -+ Fixed minor bug that could display a JavaScript error dialogue if an exception occurred in an action initiated by clicking a link in the main display. -+ Numerous refactorings. - +* Appearance of comments that appear at the top of generated source code was changed. +* Slightly modified "license" that appears at the top of some generated units. +* Information about contributor of imported code is now appended to snippet's "extra" information. +* Added a garbage collector. +* Changed size of About box - now wider and credits scroll boxes are now taller. Added credit for encryption code. +* Fixed minor bug that could display a JavaScript error dialogue if an exception occurred in an action initiated by clicking a link in the main display. +* Numerous refactorings. ## Release v3.2 of 17 August 2009 -+ Added facility for CodeSnip to use a proxy server when accessing the Internet. -+ Provided a new dialogue box to configure any proxy server. -+ Updated help file re proxy server support and configuration. -+ UI is no longer frozen while web services are executing requests. "Update from Web" dialogue box changed to indicate if cancel button pressed when a web request is executing. -+ Product version reported in generated source code header comments, splash screen and about box now includes any special build information. -+ Some minor code tweaks and refactoring. - +* Added facility for CodeSnip to use a proxy server when accessing the Internet. +* Provided a new dialogue box to configure any proxy server. +* Updated help file re proxy server support and configuration. +* UI is no longer frozen while web services are executing requests. "Update from Web" dialogue box changed to indicate if cancel button pressed when a web request is executing. +* Product version reported in generated source code header comments, splash screen and about box now includes any special build information. +* Some minor code tweaks and refactoring. ## Release v3.1.1 of 15 August 2009 -+ Check list boxes throughout program changed so that clicking anywhere on an item toggles check state. -+ Button used to render and display extra information in snippets editor is now disabled when there is no extra information to display. -+ Made minor changes to layout of some dialogue boxes: replaced missing text in bug report dialogue box. -+ Some refactorings. - +* Check list boxes throughout program changed so that clicking anywhere on an item toggles check state. +* Button used to render and display extra information in snippets editor is now disabled when there is no extra information to display. +* Made minor changes to layout of some dialogue boxes: replaced missing text in bug report dialogue box. +* Some refactorings. ## Release v3.1 of 11 August 2009 -+ Added a button to the snippets editor to preview an HTML rendering of the mark-up entered as extra information. Includes facility to check any links in the mark-up. - +* Added a button to the snippets editor to preview an HTML rendering of the mark-up entered as extra information. Includes facility to check any links in the mark-up. ## Release v3.0.5 of 21 July 2009 -+ Default font is now dependent on underlying OS: Vista - Segoe UI, XP/2000 - Tahoma, NT - MS Sans Serif. -+ Some dialogues and splash screen modified to accommodate OS font, in particular larger Vista font. Some also given a light makeover. - +* Default font is now dependent on underlying OS: Vista - Segoe UI, XP/2000 - Tahoma, NT - MS Sans Serif. +* Some dialogues and splash screen modified to accommodate OS font, in particular larger Vista font. Some also given a light makeover. ## Release v3.0.4 of 13 July 2009 -+ Added a snippet's category description to main display and to snippet information copied to clipboard or printed. Category description in main display can be clicked to display the category. -+ Refactored code that displays clicked routines and code that displays a snippet for editing. - +* Added a snippet's category description to main display and to snippet information copied to clipboard or printed. Category description in main display can be clicked to display the category. +* Refactored code that displays clicked routines and code that displays a snippet for editing. ## Unreleased v3.0.3 of 12 July 2009 -+ Refactored code: - - Rationalised some JavaScript code. - - Rationalised some dialogue alignment code. - - Changed some object types and class hierarchies. - - Added some automatic object lifetime management logic. - - Removed some duplicate code and merged some units. -+ Fixed an obscure bug in category code snippet generation as a side effect of refactoring. - +* Refactored code: + * Rationalised some JavaScript code. + * Rationalised some dialogue alignment code. + * Changed some object types and class hierarchies. + * Added some automatic object lifetime management logic. + * Removed some duplicate code and merged some units. +* Fixed an obscure bug in category code snippet generation as a side effect of refactoring. ## Release v3.0.2 of 08 July 2009 -+ Fixed broken link to CodeSnip database in welcome page. -+ Fixed bug in selection search that was selecting both user defined and main database snippets with same name if only one was selected. -+ Fixed bug where units required by constants and type definitions were not being added to generated units. - +* Fixed broken link to CodeSnip database in welcome page. +* Fixed bug in selection search that was selecting both user defined and main database snippets with same name if only one was selected. +* Fixed bug where units required by constants and type definitions were not being added to generated units. ## Release v3.0.1 of 06 July 2009 -+ Added support for file:// protocol in links in a snippet's extra information. -+ Updated help file re changes to extra info. -+ Updated exported code and user database file formats to v4 to accommodate revised extra information, although we now save data in v3 format if possible. - +* Added support for file:// protocol in links in a snippet's extra information. +* Updated help file re changes to extra info. +* Updated exported code and user database file formats to v4 to accommodate revised extra information, although we now save data in v3 format if possible. ## Release v3.0 of 29 June 2009 -+ Added support for constants and type definition snippets: there are now four types of snippets - routines, constants, types and free-form (which don't conform to any format). Free-form snippets cannot be included in generated units. -+ Further formatting instructions added to the active text used in database's Extra information field. Also added a contributors field to database. -+ Three predefined syntax highlighters are now provided, with default changing to Delphi 2006 default style. Syntax highlighting used in main display is now customisable. Highlighter keyword list updated. -+ Main display changed: - - Test unit is no longer displayed in compiler check pane: it's now displayed in a dialogue box. - - Compiler check pane's font changed to true type, with face depending on OS. - - Information pane now hides compiler table when a free-form snippet is displayed. - - Compiler check pane now displays special "not available" pages when no compilers installed or a free-form snippet or a section header is selected. - - "Uncategorised" tab removed from overview pane and replaced with new "Alphabetical" tab that groups snippets by initial letter and "Snippet Kind" tab that groups snippets by kind. - - "Section" nodes in overview pane can now be expanded and collapsed: pane now has toolbar to perform these actions. - - "Edit snippet" links displayed in information pane are now also displayed in compiler check pane. - - Information about snippet type added to information pane. - - Context menu added to overview pane. - - Some changes to menu glyphs and short-cut keys. - - Welcome display modified and now has a link to the donate dialogue box. -+ Added option to copy an snippet's source code to clipboard in text and RTF formats. -+ Exporting and copying of snippets complete with descriptions and cross references is restricted to routines: not supported for free-form, types and constants. -+ Improved detection of invalid dependencies in snippets, including circular dependencies, and provided option to view all dependencies for any snippet from main window and snippets editor. -+ Revised content of many dialogue boxes etc to refer to "snippets" instead of "routines" where necessary. -+ Changed format and location of user-defined database and format of exported and submitted files. -+ Added new "Imported Snippets" category that receives imported routines: they were formerly imported into the "User Defined" category -+ Modified code that reads main database to deal with revised file format for new snippets types and introduction of pre-processor instructions to enable retrofitting of new snippets without breaking earlier versions of CodeSnip. -+ Changed name and location of user preference configuration file. -+ Revised external object that communicates with JavaScript in browser controls. -+ Updated program credits in about box, restyled and widened it. -+ Changed size of preferences dialogue box and revised syntax highlighter tab. -+ Changed captions in preview dialogue box. -+ Changed appearance of splash screen. -+ Modified snippets editor to work with new snippet types, improved error checking code and prevented test compilation of free-form snippets. -+ Speeded up loading of main database. -+ Added an Easter egg! -+ A few refactorings. -+ Fixed several bugs: - - Bug in backup files including database files larger than 32Kb was fixed. - - Bug in history list following editing user defined snippets fixed by clearing list after snippets have been edited. - - Imported user defined routines no longer forget any dependencies on main database snippets. - - Occasional bug in displaying test unit fixed by displaying test unit in dialogue box instead of main display. -+ Modified installer re new folder structure and copying over data from previous versions. -+ Revised help file to reflect changes. Added new main contents "chapter" about the various snippet types. - +* Added support for constants and type definition snippets: there are now four types of snippets - routines, constants, types and free-form (which don't conform to any format). Free-form snippets cannot be included in generated units. +* Further formatting instructions added to the active text used in database's Extra information field. Also added a contributors field to database. +* Three predefined syntax highlighters are now provided, with default changing to Delphi 2006 default style. Syntax highlighting used in main display is now customisable. Highlighter keyword list updated. +* Main display changed: + * Test unit is no longer displayed in compiler check pane: it's now displayed in a dialogue box. + * Compiler check pane's font changed to true type, with face depending on OS. + * Information pane now hides compiler table when a free-form snippet is displayed. + * Compiler check pane now displays special "not available" pages when no compilers installed or a free-form snippet or a section header is selected. + * "Uncategorised" tab removed from overview pane and replaced with new "Alphabetical" tab that groups snippets by initial letter and "Snippet Kind" tab that groups snippets by kind. + * "Section" nodes in overview pane can now be expanded and collapsed: pane now has toolbar to perform these actions. + * "Edit snippet" links displayed in information pane are now also displayed in compiler check pane. + * Information about snippet type added to information pane. + * Context menu added to overview pane. + * Some changes to menu glyphs and short-cut keys. + * Welcome display modified and now has a link to the donate dialogue box. +* Added option to copy an snippet's source code to clipboard in text and RTF formats. +* Exporting and copying of snippets complete with descriptions and cross references is restricted to routines: not supported for free-form, types and constants. +* Improved detection of invalid dependencies in snippets, including circular dependencies, and provided option to view all dependencies for any snippet from main window and snippets editor. +* Revised content of many dialogue boxes etc to refer to "snippets" instead of "routines" where necessary. +* Changed format and location of user-defined database and format of exported and submitted files. +* Added new "Imported Snippets" category that receives imported routines: they were formerly imported into the "User Defined" category +* Modified code that reads main database to deal with revised file format for new snippets types and introduction of pre-processor instructions to enable retrofitting of new snippets without breaking earlier versions of CodeSnip. +* Changed name and location of user preference configuration file. +* Revised external object that communicates with JavaScript in browser controls. +* Updated program credits in about box, restyled and widened it. +* Changed size of preferences dialogue box and revised syntax highlighter tab. +* Changed captions in preview dialogue box. +* Changed appearance of splash screen. +* Modified snippets editor to work with new snippet types, improved error checking code and prevented test compilation of free-form snippets. +* Speeded up loading of main database. +* Added an Easter egg! +* A few refactorings. +* Fixed several bugs: + * Bug in backup files including database files larger than 32Kb was fixed. + * Bug in history list following editing user defined snippets fixed by clearing list after snippets have been edited. + * Imported user defined routines no longer forget any dependencies on main database snippets. + * Occasional bug in displaying test unit fixed by displaying test unit in dialogue box instead of main display. +* Modified installer re new folder structure and copying over data from previous versions. +* Revised help file to reflect changes. Added new main contents "chapter" about the various snippet types. ## Unreleased v2.4.1 of 13 May 2009 -+ Refactored code that provides information about the program and web URLs and services it accesses. -+ Changed URL accessed by donations dialogue box. - +* Refactored code that provides information about the program and web URLs and services it accesses. +* Changed URL accessed by donations dialogue box. ## Release v2.4 of 11 May 2009 -+ Added donate menu option and dialogue that accesses a PayPal donation web page. -+ Removed support for the Windows 9x platform since CodeSnip now generates fatal errors on that platform: - - Removed Windows 9x specific code. - - Changed installer to prevent installation on Windows 9x. -+ Updated help file re changes. - +* Added donate menu option and dialogue that accesses a PayPal donation web page. +* Removed support for the Windows 9x platform since CodeSnip now generates fatal errors on that platform: + * Removed Windows 9x specific code. + * Changed installer to prevent installation on Windows 9x. +* Updated help file re changes. ## Release v2.3.7 of 26 April 2009 -+ Made user name and email address entered in Code Submission Wizard persistent on a per-user basis. -+ Updated Code Submission Wizard and Privacy Statement help topics re the changes. - +* Made user name and email address entered in Code Submission Wizard persistent on a per-user basis. +* Updated Code Submission Wizard and Privacy Statement help topics re the changes. ## Unreleased v2.3.6 of 26 January 2009 -+ Changed method that is used to get locale information to be compatible with Vista as well as earlier OSs. - +* Changed method that is used to get locale information to be compatible with Vista as well as earlier OSs. ## Release v2.3.5 of 25 January 2009 -+ Changed method used to generate HTML displayed in main program window to avoid dynamic updating of documents in attempt to counter a reported JavaScript bug. -+ Refactored generation of HTML tags in all parts of program that use HTML in display. -+ Corrected method naming error. - +* Changed method used to generate HTML displayed in main program window to avoid dynamic updating of documents in attempt to counter a reported JavaScript bug. +* Refactored generation of HTML tags in all parts of program that use HTML in display. +* Corrected method naming error. ## Unreleased v2.3.4 of 16 January 2009 -+ Copy Source Code menu item now places a copy of selected snippet on clipboard in syntax highlighted rich text in addition to plain text. -+ Updated help file accordingly. - +* Copy Source Code menu item now places a copy of selected snippet on clipboard in syntax highlighted rich text in addition to plain text. +* Updated help file accordingly. ## Unreleased v2.3.3 of 14 January 2009 -+ Browser controls and snippets tree-views are now selected when containing frame is entered. -+ Discrepancy in way highlighting works in snippets tree-views fixed. -+ "&" characters are now rendered correctly in TMessageBox dialogues. -+ Code that executes compilers now uses one thread instead of two. -+ Refactorings: - - Some constants relocated. - - Rationalised some routine and method calls. - - Replaced some control character literals with constants. - - Updated IntfUIHandlers unit with IE6/7 related constants. - +* Browser controls and snippets tree-views are now selected when containing frame is entered. +* Discrepancy in way highlighting works in snippets tree-views fixed. +* "&" characters are now rendered correctly in TMessageBox dialogues. +* Code that executes compilers now uses one thread instead of two. +* Refactorings: + * Some constants relocated. + * Rationalised some routine and method calls. + * Replaced some control character literals with constants. + * Updated IntfUIHandlers unit with IE6/7 related constants. ## Unreleased v2.3.2 of 10 January 2009 -+ Revised compilers object. Singleton instance removed. Local instances of object are created where needed. -+ Added new method to compiler objects to detect errors and warnings -+ Fixed incorrect caption in compiler error dialogue. -+ Added new object that manages test compilations, compiler set-up and viewing compile errors. Used by main form and snippets editor. -+ Added "View Compile Errors" menu option to Database menu. -+ Added Alt+V hot key to view compile errors in Snippets editor. -+ Updated help file for database menu to add "View Compile Errors" and missing entries for Submission, import and export of user database. - +* Revised compilers object. Singleton instance removed. Local instances of object are created where needed. +* Added new method to compiler objects to detect errors and warnings +* Fixed incorrect caption in compiler error dialogue. +* Added new object that manages test compilations, compiler set-up and viewing compile errors. Used by main form and snippets editor. +* Added "View Compile Errors" menu option to Database menu. +* Added Alt+V hot key to view compile errors in Snippets editor. +* Updated help file for database menu to add "View Compile Errors" and missing entries for Submission, import and export of user database. ## Unreleased v2.3.1 of 06 January 2009 -+ Fixed test compilation bug in snippets editor that could corrupt compiler errors or warnings displayed from main display. -+ Added support for tab switching in compiler errors dialogue box using Ctrl+Tab and Shift+Ctrl+Tab. - +* Fixed test compilation bug in snippets editor that could corrupt compiler errors or warnings displayed from main display. +* Added support for tab switching in compiler errors dialogue box using Ctrl+Tab and Shift+Ctrl+Tab. ## Release v2.3 of 05 January 2009 -+ Changed name of Copy Snippet menu item to Copy Source Code. -+ Added new Copy Information menu item to Copy menu - copies all snippet information to clipboard in text and RTF. -+ Added Save Database button to toolbar. -+ Changed status bar to display a count of user defined routines and an indicator that shows when user database has been modified. -+ Refactored and extended clipboard management code. -+ Added new buttons to selection search dialogue box to select user defined or main database routines. -+ Added facility to test compile routines to user defined snippets editor dialogue box. -+ Modified compiler errors dialogue box to be able to display results of compilation with more than one compiler. -+ Updated help file re changes. - +* Changed name of Copy Snippet menu item to Copy Source Code. +* Added new Copy Information menu item to Copy menu - copies all snippet information to clipboard in text and RTF. +* Added Save Database button to toolbar. +* Changed status bar to display a count of user defined routines and an indicator that shows when user database has been modified. +* Refactored and extended clipboard management code. +* Added new buttons to selection search dialogue box to select user defined or main database routines. +* Added facility to test compile routines to user defined snippets editor dialogue box. +* Modified compiler errors dialogue box to be able to display results of compilation with more than one compiler. +* Updated help file re changes. ## Release v2.2.5 of 31 December 2008 -+ Replaced routine's credits and comments properties with new Extra information property that can store formatted text. -+ Added parser for mark-up language used by new Extra property. -+ Modified snippets edit dialogue box to use new Extra property. -+ Changed main database, user database and export file format to support new Extra property. User database and export files generated by this version can't be read by earlier versions of the program. -+ Modified and refactored print document generation code to use new Extra property. -+ Refactored some HTML generation code. -+ Fixed a bug that occasionally causes a GPF when updating a user defined routine. -+ Removed redundant topic from help file. - +* Replaced routine's credits and comments properties with new Extra information property that can store formatted text. +* Added parser for mark-up language used by new Extra property. +* Modified snippets edit dialogue box to use new Extra property. +* Changed main database, user database and export file format to support new Extra property. User database and export files generated by this version can't be read by earlier versions of the program. +* Modified and refactored print document generation code to use new Extra property. +* Refactored some HTML generation code. +* Fixed a bug that occasionally causes a GPF when updating a user defined routine. +* Removed redundant topic from help file. ## Release v2.2.4 of 19 December 2008 -+ Fixed bug in text and RTF preview dialogue boxes that was setting margins incorrectly and clipping displayed text. - +* Fixed bug in text and RTF preview dialogue boxes that was setting margins incorrectly and clipping displayed text. ## Unreleased v2.2.3 of 17 December 2008 -+ Refactored code that handles XML files (user database and import / export). Pulled out common code and further extended XML document object. - +* Refactored code that handles XML files (user database and import / export). Pulled out common code and further extended XML document object. ## Unreleased v2.2.2 of 16 December 2008 -+ Added glyphs to printers in print dialogue box. -+ Various refactorings of print and highlighting related code. -+ Printing now uses user-defined highlighters. Current highlighting is now previewed in print preferences. -+ Bug fixes: - - Help button now displays in page set-up dialogue on Vista. - - Page set-up dialogue now makes use of custom margin settings. - +* Added glyphs to printers in print dialogue box. +* Various refactorings of print and highlighting related code. +* Printing now uses user-defined highlighters. Current highlighting is now previewed in print preferences. +* Bug fixes: + * Help button now displays in page set-up dialogue on Vista. + * Page set-up dialogue now makes use of custom margin settings. ## Unreleased v2.2.1 of 16 December 2008 -+ Several refactorings: - - Rationalised email validation code. - - Rationalised exceptions raised when validating entry into dialogue box. - - Rationalised code that momentarily pauses execution of a thread. - - Made wide use of extended TRect structure. - - Changed various loops to use enumerators. - - Removed some unused code. -+ Fixed minor bug in open and save dialogues that occasionally failed to detect existence of a file. - +* Several refactorings: + * Rationalised email validation code. + * Rationalised exceptions raised when validating entry into dialogue box. + * Rationalised code that momentarily pauses execution of a thread. + * Made wide use of extended TRect structure. + * Changed various loops to use enumerators. + * Removed some unused code. +* Fixed minor bug in open and save dialogues that occasionally failed to detect existence of a file. ## Unreleased v2.2 of 15 December 2008 -+ Added facility to submit user defined snippets via Internet for inclusion in main database. -+ Added facility to export user defined routines to file and to import exported files. -+ Made minor changes to wizard dialogue boxes. -+ Rewrote message dialogue box code. -+ Made minor changes to open and save dialogue boxes. -+ Updated help file for the new code import, export and submission features. - +* Added facility to submit user defined snippets via Internet for inclusion in main database. +* Added facility to export user defined routines to file and to import exported files. +* Made minor changes to wizard dialogue boxes. +* Rewrote message dialogue box code. +* Made minor changes to open and save dialogue boxes. +* Updated help file for the new code import, export and submission features. ## Release v2.1 of 11 October 2008 -+ Added support for Delphi 2009 Win 32 personality. -+ Added a button to set all compiler results to success to snippets edit dialogue box. -+ Refactored some code. -+ Updated help file re Delphi 2009 support. - +* Added support for Delphi 2009 Win 32 personality. +* Added a button to set all compiler results to success to snippets edit dialogue box. +* Refactored some code. +* Updated help file re Delphi 2009 support. ## Unreleased v2.0.7 of 05 October 2008 -+ Fixed residual bug in alt key bug work-around (CodeGear Quality Central bug report #374030). The bug was manifesting itself only for the first dialogue box displayed after the program started. - +* Fixed residual bug in alt key bug work-around (CodeGear Quality Central bug report #374030). The bug was manifesting itself only for the first dialogue box displayed after the program started. ## Unreleased v2.0.6 of 05 October 2008 -+ Refactoring: - - Added class methods to instantiate and use various classes that have only one public method to save caller having to create, execute and destroy object. Public constructors of these classes were changed to cause assertion failure if directly called. - - Made static classes derive from new base class that causes assertion failure if constructor called. - - Combined some action update handlers in main form. - - Updated assertions and raising of EBug exceptions to programatically get name of class triggering error. - - Made some class' protected and private sections strict. - +* Refactoring: + * Added class methods to instantiate and use various classes that have only one public method to save caller having to create, execute and destroy object. Public constructors of these classes were changed to cause assertion failure if directly called. + * Made static classes derive from new base class that causes assertion failure if constructor called. + * Combined some action update handlers in main form. + * Updated assertions and raising of EBug exceptions to programatically get name of class triggering error. + * Made some class' protected and private sections strict. ## Unreleased v2.0.5 of 03 October 2008 -+ Refactoring: changed custom save source dialogue to descend from extended save dialogue box. - +* Refactoring: changed custom save source dialogue to descend from extended save dialogue box. ## Release v2.0.4 of 21 September 2008 -+ Improved speed of looking up routines in database. -+ Prevented any user defined routine from referencing itself. -+ User defined routines now always reference routines from user database in preference to main database when there is a name conflict. - +* Improved speed of looking up routines in database. +* Prevented any user defined routine from referencing itself. +* User defined routines now always reference routines from user database in preference to main database when there is a name conflict. ## Unreleased v2.0.3 of 20 September 2008 -+ Fixed bug that caused an assertion failure when an attempt was made to display the Select Routines dialogue box when an empty category was present in database. - +* Fixed bug that caused an assertion failure when an attempt was made to display the Select Routines dialogue box when an empty category was present in database. ## Unreleased v2.0.2 of 19 September 2008 -+ Now gives option to save changed user defined database before updated main database. -+ When a routine is updated or deleted references to it in other routines are updated or removed. -+ Corrected reference in installer to menu item used to update database (this changed from v2). - +* Now gives option to save changed user defined database before updated main database. +* When a routine is updated or deleted references to it in other routines are updated or removed. +* Corrected reference in installer to menu item used to update database (this changed from v2). ## Release v2.0.1 of 18 September 2008 -+ Fixed bug that fails to load user database and deletes it if a category is added to main database during on-line update. -+ Fixed bug that ignores any user defined snippets that have same name as snippets in main database. -+ Ensured main form is disabled when database is loading. -+ Ensured splash form is hidden if an exception occurs while splash form is displayed. - +* Fixed bug that fails to load user database and deletes it if a category is added to main database during on-line update. +* Fixed bug that ignores any user defined snippets that have same name as snippets in main database. +* Ensured main form is disabled when database is loading. +* Ensured splash form is hidden if an exception occurs while splash form is displayed. ## Release v2.0 of 15 September 2008 -+ Added support for user defined snippets: - - User database can be edited, saved, backed-up and restored. - - User database can reference code in main database. - - Names of user defined snippets are coloured blue to distinguish them from main database. - - User database is stored as a mix of XML and source files in a sub-folder of the per-user application data folder. - - Queries can now be refreshed when content of user database changes. -+ Modified extended external object that communicates between browser controls and application. -+ Main database engine heavily modified. -+ Greater use of DHTML to manipulate main display. -+ Made browser pop-up menu display glyphs for items menu items that replicate links in browser control. -+ Modified welcome page to appear differently depending on state of main and user defined databases. -+ Disclaimers, copyright and other headers of saved, printed and copied documents changed. -+ Commenting of exported code changed slightly to allow for user snippets that may not support all commenting styles. -+ Fixed status bar display bug. -+ Category headers in overview pane are now in bold. -+ Added enumerators to several list objects to support for..in construct. -+ Tweaked exception handling. -+ Added support for converting GIF resources into bitmaps for use in image lists. -+ Changed URL used to access program's home page. -+ Updated help file to reflect changes. -+ Added credits for use of Anders Melander's GIFImage unit to about box. - +* Added support for user defined snippets: + * User database can be edited, saved, backed-up and restored. + * User database can reference code in main database. + * Names of user defined snippets are coloured blue to distinguish them from main database. + * User database is stored as a mix of XML and source files in a sub-folder of the per-user application data folder. + * Queries can now be refreshed when content of user database changes. +* Modified extended external object that communicates between browser controls and application. +* Main database engine heavily modified. +* Greater use of DHTML to manipulate main display. +* Made browser pop-up menu display glyphs for items menu items that replicate links in browser control. +* Modified welcome page to appear differently depending on state of main and user defined databases. +* Disclaimers, copyright and other headers of saved, printed and copied documents changed. +* Commenting of exported code changed slightly to allow for user snippets that may not support all commenting styles. +* Fixed status bar display bug. +* Category headers in overview pane are now in bold. +* Added enumerators to several list objects to support for..in construct. +* Tweaked exception handling. +* Added support for converting GIF resources into bitmaps for use in image lists. +* Changed URL used to access program's home page. +* Updated help file to reflect changes. +* Added credits for use of Anders Melander's GIFImage unit to about box. ## Release v1.9.4 of 01 September 2008 -+ Improved handling of errors encountered when running compilers. -+ Provided checks for invalid compiler executable files in Config Compilers dialogue box. -+ Added enumerator to Compilers object. -+ Made ECodeSnip exceptions and descendants clonable when copying between threads. - +* Improved handling of errors encountered when running compilers. +* Provided checks for invalid compiler executable files in Config Compilers dialogue box. +* Added enumerator to Compilers object. +* Made ECodeSnip exceptions and descendants clonable when copying between threads. ## Unreleased v1.9.3 of 24 August 2008 -+ Fixed bug in the database updater which could cause a deleted local file not to be noticed and not replaced. - +* Fixed bug in the database updater which could cause a deleted local file not to be noticed and not replaced. ## Unreleased v1.9.2 of 24 August 2008 -+ Changed method used to generate program key. No longer uses MAC Address, since code to find this fails on Windows Vista. -+ Refactored to remove knowledge of how contributor information and database are stored from TAppInfo class. -+ Revised code that manages contributors so that storage details are private to the classes. - +* Changed method used to generate program key. No longer uses MAC Address, since code to find this fails on Windows Vista. +* Refactored to remove knowledge of how contributor information and database are stored from TAppInfo class. +* Revised code that manages contributors so that storage details are private to the classes. ## Unreleased v1.9.1 of 24 August 2008 -+ Rebuilt CodeSnip and install helper program with Delphi 2006: -+ Modified CodeSnip source to compile without warnings. -+ Replaced deprecated library calls with alternatives. - +* Rebuilt CodeSnip and install helper program with Delphi 2006: +* Modified CodeSnip source to compile without warnings. +* Replaced deprecated library calls with alternatives. ## Release v1.9 of 14 August 2008 -+ Changed so that all user accounts use the same database rather than having their own copy. Database now stored in common application data folder, along with registration information. Per-user configuration information remains in per-user application data folder in renamed file. -+ Installer can now optionally preserve data stored in database and configuration file used by earlier versions of the program. This involves creating new configuration files and moving the database. -+ Updated help file re these changes. - +* Changed so that all user accounts use the same database rather than having their own copy. Database now stored in common application data folder, along with registration information. Per-user configuration information remains in per-user application data folder in renamed file. +* Installer can now optionally preserve data stored in database and configuration file used by earlier versions of the program. This involves creating new configuration files and moving the database. +* Updated help file re these changes. ## Unreleased v1.8.11 of 11 August 2008 -+ Removed duplicate compiler glyph resources and modified compiler handling code accordingly. - +* Removed duplicate compiler glyph resources and modified compiler handling code accordingly. ## Unreleased v1.8.10 of 11 August 2008 -+ Refactored various units to use extended theme support. -+ Fixed redraw bug in tree views that use check boxes: check boxes were redrawing in wrong state when themes changed. -+ Improved support for theme changes. Theme manager now gets notified of changes directly from Windows. -+ Suppressed unnecessary compiler warnings. - +* Refactored various units to use extended theme support. +* Fixed redraw bug in tree views that use check boxes: check boxes were redrawing in wrong state when themes changed. +* Improved support for theme changes. Theme manager now gets notified of changes directly from Windows. +* Suppressed unnecessary compiler warnings. ## Unreleased v1.8.9 of 10 August 2008 -+ Modified Select Compiler dialogue box (opened from Configure Compiler dialogue) and Choose Element Colour dialogue (opened from Preferences dialogue) to be aligned correctly over dialogues, work correctly with Vista task bar and support help keywords. -+ Select Compiler file open dialogue now defaults to display any current compiler executable. -+ Choose Element Colour dialogue box now uses UK English and has custom title. -+ Added help topics for Select Compiler and Choose Element Colour dialogues. - +* Modified Select Compiler dialogue box (opened from Configure Compiler dialogue) and Choose Element Colour dialogue (opened from Preferences dialogue) to be aligned correctly over dialogues, work correctly with Vista task bar and support help keywords. +* Select Compiler file open dialogue now defaults to display any current compiler executable. +* Choose Element Colour dialogue box now uses UK English and has custom title. +* Added help topics for Select Compiler and Choose Element Colour dialogues. ## Release v1.8.8 of 16 June 2008 -+ Changed to make application minimisation, task bar preview window, and appearance in "Flip 3D" task switching display correctly on Windows Vista. -+ Provided work-around for Delphi's Alt key bug on XP and Vista (CodeGear Quality Central bug report #374030). - +* Changed to make application minimisation, task bar preview window, and appearance in "Flip 3D" task switching display correctly on Windows Vista. +* Provided work-around for Delphi's Alt key bug on XP and Vista (CodeGear Quality Central bug report #374030). ## Unreleased v1.8.7 of 05 June 2008 -+ Made selected tabs in information and detail pane persistent. -+ Fixed bug in build script. - +* Made selected tabs in information and detail pane persistent. +* Fixed bug in build script. ## Unreleased v1.8.6 of 02 June 2008 -+ Fixed lock-up that could occur when displaying wait dialogue box while background tasks execute. Previous attempt to fix this problem failed. -+ Changed "marquee" that is displayed in wait dialogue box to appear correctly on Vista. - +* Fixed lock-up that could occur when displaying wait dialogue box while background tasks execute. Previous attempt to fix this problem failed. +* Changed "marquee" that is displayed in wait dialogue box to appear correctly on Vista. ## Release v1.8.5 of 30 May 2008 -+ Fixed bug that was causing Save Snippet and Save Unit dialogue boxes to ignore file type +* Fixed bug that was causing Save Snippet and Save Unit dialogue boxes to ignore file type selected by user, always outputting default file type. -+ Deleted some unused source code. -+ Removed option to install a desktop icon from installer. Also refactored install script to conform to current Inno Setup standards. - +* Deleted some unused source code. +* Removed option to install a desktop icon from installer. Also refactored install script to conform to current Inno Setup standards. ## Release v1.8.4 of 22 April 2008 -+ Added manifest resource to ensure compatibility with Windows Vista and to use Vista themes. -+ Fixed border problem in web update dialogue box and about box when displayed under Vista / IE7 browser control. -+ Prevented selection of text in previews displayed in preferences dialogue box. -+ Updated set-up script to use macros. -+ Modified Build batch file to work with Windows SDK 2008. - +* Added manifest resource to ensure compatibility with Windows Vista and to use Vista themes. +* Fixed border problem in web update dialogue box and about box when displayed under Vista / IE7 browser control. +* Prevented selection of text in previews displayed in preferences dialogue box. +* Updated set-up script to use macros. +* Modified Build batch file to work with Windows SDK 2008. ## Unreleased v1.8.3 of 05 November 2007 -+ Refactored dynamic CSS generation code. - +* Refactored dynamic CSS generation code. ## Unreleased v1.8.2 of 04 November 2007 -+ Refactored assignable interfaced objects. - +* Refactored assignable interfaced objects. ## Release v1.8.1 of 04 November 2007 -+ Made changes to browser control and URL handling. - +* Made changes to browser control and URL handling. ## Unreleased v1.8 of 04 November 2007 -+ Added pop-up context menus to main display's detail pane. - +* Added pop-up context menus to main display's detail pane. ## Unreleased v1.7.7 of 29 October 2007 -+ Modified code of compiler wait dialogue box and splash screen to try to prevent bug that occasionally prevent the dialogue from closing, locking up application. - +* Modified code of compiler wait dialogue box and splash screen to try to prevent bug that occasionally prevent the dialogue from closing, locking up application. ## Unreleased v1.7.6 of 18 October 2007 -+ Shift-clicking links in the main display and some dialogue boxes was starting Internet Explorer. Fixed so that Internet Explorer is no longer started and shift-clicking external links now starts default browser. - +* Shift-clicking links in the main display and some dialogue boxes was starting Internet Explorer. Fixed so that Internet Explorer is no longer started and shift-clicking external links now starts default browser. ## Unreleased v1.7.5 of 17 October 2007 -+ Modified Preferences dialogue box: - - Refactored code that displays measurement units. - - Preview on Source Code tab now takes on appearance of source code highlighter defined on Syntax Highlighter tab. -+ Changed format of ini file that stores persistent settings so that source code highlighter preferences are now stored in Prefs section of ini file rather than own section. -+ Customised installer to update existing ini files to revised version. - +* Modified Preferences dialogue box: + * Refactored code that displays measurement units. + * Preview on Source Code tab now takes on appearance of source code highlighter defined on Syntax Highlighter tab. +* Changed format of ini file that stores persistent settings so that source code highlighter preferences are now stored in Prefs section of ini file rather than own section. +* Customised installer to update existing ini files to revised version. ## Release v1.7.4 of 14 October 2007 -+ Fixed display bug when selecting routines following a text search. -+ Improved text search algorithm to permit search strings containing punctuation characters. -+ Fixed typo in the "About The Database" section of the About box. - +* Fixed display bug when selecting routines following a text search. +* Improved text search algorithm to permit search strings containing punctuation characters. +* Fixed typo in the "About The Database" section of the About box. ## Release v1.7.3 of 27 September 2007 -+ Improved alignment of dialogue boxes and splash screen over owning forms. Alignment code substantially refactored. -+ Added support for multiple monitors. - +* Improved alignment of dialogue boxes and splash screen over owning forms. Alignment code substantially refactored. +* Added support for multiple monitors. ## Release v1.7.2 of 24 September 2007 -+ Fixed bug that was preventing wait dialogue box from displaying during long compilations. - +* Fixed bug that was preventing wait dialogue box from displaying during long compilations. ## Unreleased v1.7.1 of 22 September 2007 -+ Added list of testers to credits section of Database tab in About box. -+ Added new help menu item that displays privacy statement. -+ Rearranged help menu items. -+ Updated help file re changes to help menu. - +* Added list of testers to credits section of Database tab in About box. +* Added new help menu item that displays privacy statement. +* Rearranged help menu items. +* Updated help file re changes to help menu. ## Release v1.7 of 08 September 2007 -+ Added new facility to print information about selected routines, with page set-up and printer configuration. -+ Added new "general" tab (sets default measurement units) and "printing" tab (to set printing defaults) to preferences dialogue box. -+ Changed format of ini file that stores persistent settings. -+ Updated help file to reflect changes. -+ Customised installer to update existing ini files to revised version. - +* Added new facility to print information about selected routines, with page set-up and printer configuration. +* Added new "general" tab (sets default measurement units) and "printing" tab (to set printing defaults) to preferences dialogue box. +* Changed format of ini file that stores persistent settings. +* Updated help file to reflect changes. +* Customised installer to update existing ini files to revised version. ## Unreleased v1.6.4 of 02 July 2007 -+ Corrected typos in generated source code header comments. -+ Added support for embedding titles in generated documents where document supports title meta data. -+ Added suggested file name to save unit and save snippets dialogue boxes. -+ Refactored code in syntax highlighter that generates XHTML. - +* Corrected typos in generated source code header comments. +* Added support for embedding titles in generated documents where document supports title meta data. +* Added suggested file name to save unit and save snippets dialogue boxes. +* Refactored code in syntax highlighter that generates XHTML. ## Unreleased v1.6.3 of 13 May 2007 -+ Added support for selecting and copying text displayed in preview dialogue. -+ Changed so that each document type displayed in preview dialogue box has same margins. -+ Updated help file re changes to preview dialogue box. - +* Added support for selecting and copying text displayed in preview dialogue. +* Changed so that each document type displayed in preview dialogue box has same margins. +* Updated help file re changes to preview dialogue box. ## Unreleased v1.6.2 of 12 May 2007 -+ Updated to use revised news data format provided by web service. -+ Update from Web dialogue box now displays number of news items along with page number of currently displayed item. - +* Updated to use revised news data format provided by web service. +* Update from Web dialogue box now displays number of news items along with page number of currently displayed item. ## Release v1.6.1 of 09 May 2007 -+ Fixed bug that allowed user to select a different routine while compiling another causing display to get out sync. - +* Fixed bug that allowed user to select a different routine while compiling another causing display to get out sync. ## Release v1.6 of 08 May 2007 -+ Added support for Delphi 2007 compiler. -+ Updated help file re new compiler support. - +* Added support for Delphi 2007 compiler. +* Updated help file re new compiler support. ## Release v1.5.13 of 04 March 2007 -+ Fixed bug from v1.5.11 where Tools | Register CodeSnip and View | Show/Hide Test Unit menu options were permanently disabled. -+ Fixed bug from v1.5.9 where showing and hiding test units from menus was out of sync with links in compiler check pane. - +* Fixed bug from v1.5.11 where Tools | Register CodeSnip and View | Show/Hide Test Unit menu options were permanently disabled. +* Fixed bug from v1.5.9 where showing and hiding test units from menus was out of sync with links in compiler check pane. ## Release v1.5.12 of 01 March 2007 -+ Made long operations (loading database and compiling test units) execute in threads. -+ Changed to display wait dialogue while updated database is being loaded. -+ Made progress meters displayed in wait dialogues update more smoothly. - +* Made long operations (loading database and compiling test units) execute in threads. +* Changed to display wait dialogue while updated database is being loaded. +* Made progress meters displayed in wait dialogues update more smoothly. ## Release v1.5.11 of 25 February 2007 -+ Added splash screen displayed when program is loading. -+ Main window, menu and toolbar is now disabled when program is initialising and when updated database is loading. -+ Program window is now centred on screen first time it is run and program is now never started minimized. - +* Added splash screen displayed when program is loading. +* Main window, menu and toolbar is now disabled when program is initialising and when updated database is loading. +* Program window is now centred on screen first time it is run and program is now never started minimized. ## Unreleased v1.5.10 of 17 February 2007 -+ Refactored code that handles web browser controls. Moved various pieces of code that manipulates and queries browser controls into central UI and IO manager classes. Also added helper classes to manipulate HTML documents and browser controls. -+ Some code made redundant by above changes was removed. -+ Lightened and centralised colours used to highlight text search results. - +* Refactored code that handles web browser controls. Moved various pieces of code that manipulates and queries browser controls into central UI and IO manager classes. Also added helper classes to manipulate HTML documents and browser controls. +* Some code made redundant by above changes was removed. +* Lightened and centralised colours used to highlight text search results. ## Unreleased v1.5.9 of 16 February 2007 -+ Refactoring update. Revised code that manages the main display, i.e overview and details panes. - +* Refactoring update. Revised code that manages the main display, i.e overview and details panes. ## Release v1.5.8 of 16 February 2007 -+ Fixed bug in view history where selecting an item from the history list could cause a crash after database has been updated. This was fixed by clearing the history list after updating the database. -+ Now clears the main display before re-displaying an updated database to prevent an item from the old version of the database being selected. - +* Fixed bug in view history where selecting an item from the history list could cause a crash after database has been updated. This was fixed by clearing the history list after updating the database. +* Now clears the main display before re-displaying an updated database to prevent an item from the old version of the database being selected. ## Unreleased v1.5.7 of 12 February 2007 -+ Refactored, relocated and extended use of some utility routines, resulting in some other minor changes: - - All error and information message boxes now have properly terminated sentences. - - Generated XHTML less likely to contain illegal characters. - +* Refactored, relocated and extended use of some utility routines, resulting in some other minor changes: + * All error and information message boxes now have properly terminated sentences. + * Generated XHTML less likely to contain illegal characters. ## Unreleased v1.5.6 of 11 February 2007 -+ Modified about dialogue box to display information about the Code Snippets Database in addition to the program. The two kinds of information are displayed in two tabs. -+ Added code to get list of database contributors from a file downloaded with database updates. - +* Modified about dialogue box to display information about the Code Snippets Database in addition to the program. The two kinds of information are displayed in two tabs. +* Added code to get list of database contributors from a file downloaded with database updates. ## Unreleased v1.5.5 of 11 February 2007 -+ Made keyboard interaction with application more consistent: - - Made browser controls activate and focus properly when user tabs into them. - - Fixed tab order problems in main display and about dialogue box so that only controls that may need to receive user input are now activated by tabbing. - - Links displayed in browser controls are always now included in tab sequence and can be activated by Ctrl+Return when focused. - - Fixed inconsistency in tab sets in overview and details pane responded inconsistently to Ctrl+Tab and Shift+Ctrl+Tab. -+ Changed browser control respond to activation via the mouse to be the same as for the keyboard. - +* Made keyboard interaction with application more consistent: + * Made browser controls activate and focus properly when user tabs into them. + * Fixed tab order problems in main display and about dialogue box so that only controls that may need to receive user input are now activated by tabbing. + * Links displayed in browser controls are always now included in tab sequence and can be activated by Ctrl+Return when focused. + * Fixed inconsistency in tab sets in overview and details pane responded inconsistently to Ctrl+Tab and Shift+Ctrl+Tab. +* Changed browser control respond to activation via the mouse to be the same as for the keyboard. ## Release v1.5.4 of 09 February 2007 -+ Added disclaimers re database code to generated units and snippets and to program's welcome page. -+ Made slight modifications to source code generation code. +* Added disclaimers re database code to generated units and snippets and to program's welcome page. +* Made slight modifications to source code generation code. ## Release v1.5.3 of 08 February 2007 -+ Refactored and rationalised code in main form and moved some code into help classes. -+ Revised code that performs customisation, auto-sizing and alignment of forms and dialogue boxes. -+ Standardised execution method of dialogue boxes. - +* Refactored and rationalised code in main form and moved some code into help classes. +* Revised code that performs customisation, auto-sizing and alignment of forms and dialogue boxes. +* Standardised execution method of dialogue boxes. ## Unreleased v1.5.2 of 04 February 2007 -+ Refactored help manager system to make it easier to swap in new help systems in future. -+ Modified help handlers in forms to remove redundant code. -+ Modified how help menu items call help topics. - +* Refactored help manager system to make it easier to swap in new help systems in future. +* Modified help handlers in forms to remove redundant code. +* Modified how help menu items call help topics. ## Unreleased v1.5.1 of 04 February 2007 -+ Refactored handling of database searches by creating new global query object to store information about current query on database. -+ Changed relevant code to use the new object and deleted resulting redundant code. -+ Made some other minor code improvements and modifications. - +* Refactored handling of database searches by creating new global query object to store information about current query on database. +* Changed relevant code to use the new object and deleted resulting redundant code. +* Made some other minor code improvements and modifications. ## Unreleased v1.5 of 03 February 2007 -+ Made status bar display database and search information along with other prompts in addition to displaying hints. - +* Made status bar display database and search information along with other prompts in addition to displaying hints. ## Unreleased v1.4.6 of 17 December 2006 -+ Made minor changes to appearance: - - Changed some colours to system colours from hard-wired colours. - - Changed help links in main display from blue to green. - - Removed text highlighting from welcome page. - +* Made minor changes to appearance: + * Changed some colours to system colours from hard-wired colours. + * Changed help links in main display from blue to green. + * Removed text highlighting from welcome page. ## Unreleased v1.4.5 of 04 December 2006 -+ Refactored code that generates test units. As a consequence names of test units displayed in Compiler Check pane have been corrected to the actual names used in test compilations. - +* Refactored code that generates test units. As a consequence names of test units displayed in Compiler Check pane have been corrected to the actual names used in test compilations. ## Release v1.4.4 of 04 December 2006 -+ Added new menu item to View menu that toggles visibility of test units in the compiler check tab. -+ Changed glyph used for link that performs same action in compiler check tab and made image change depending on visibility of test unit. - +* Added new menu item to View menu that toggles visibility of test units in the compiler check tab. +* Changed glyph used for link that performs same action in compiler check tab and made image change depending on visibility of test unit. ## Unreleased v1.4.3 of 03 December 2006 -+ Changed information pane to load routines dynamically via DHTML rather than reloading document each time. -+ Refactored DHTML code and detail frames that support DHTML. -+ Refactored routine HTML generation code. -+ Rationalised some dynamic CSS generating code. -+ Revised information pane's underlying HTML code. - +* Changed information pane to load routines dynamically via DHTML rather than reloading document each time. +* Refactored DHTML code and detail frames that support DHTML. +* Refactored routine HTML generation code. +* Rationalised some dynamic CSS generating code. +* Revised information pane's underlying HTML code. ## Unreleased v1.4.2 of 03 December 2006 -+ Corrected alignment of About and Compiler Errors dialogue boxes over main form. - +* Corrected alignment of About and Compiler Errors dialogue boxes over main form. ## Unreleased v1.4.1 of 03 December 2006 -+ Fixed bug where Test Compile menu option and tool button were always enabled and could cause an assertion failure when no routine was selected or no compilers were available. - +* Fixed bug where Test Compile menu option and tool button were always enabled and could cause an assertion failure when no routine was selected or no compilers were available. ## Unreleased v1.4 of 03 December 2006 -+ Revised display in compiler check pane. Now lists database and test results side by side. -+ Changed routine compiler check page to be updated dynamically (using JavaScript) when routine selection changes rather than always reloading page. -+ Modified some JavaScript support code. -+ Fixed potential bug in compiler code. -+ Updated help file re changes to Compiler Check tab. -+ Fixed a typo and index error in help file. - +* Revised display in compiler check pane. Now lists database and test results side by side. +* Changed routine compiler check page to be updated dynamically (using JavaScript) when routine selection changes rather than always reloading page. +* Modified some JavaScript support code. +* Fixed potential bug in compiler code. +* Updated help file re changes to Compiler Check tab. +* Fixed a typo and index error in help file. ## Unreleased v1.3.5 of 01 December 2006 -+ Changed to display a border-less message dialogue during long test compilations. The dialogue is not displayed for shorter compilations. -+ Updated help file re above and fixed an error in the search menu topic. - +* Changed to display a border-less message dialogue during long test compilations. The dialogue is not displayed for shorter compilations. +* Updated help file re above and fixed an error in the search menu topic. ## Unreleased v1.3.4 of 26 November 2006 -+ Refactored JavaScript used to interface between main program and HTML display. -+ Centralised generation of JavaScript in main code. - +* Refactored JavaScript used to interface between main program and HTML display. +* Centralised generation of JavaScript in main code. ## Unreleased v1.3.3 of 25 November 2006 -+ Refactored handling of CSS and XHTML: - - Changed way CSS is provided to enable use of system font and colours. - - Tidied source HTML documents to remove illegal XHTML strict attributes and to remove hard-wired colours. - +* Refactored handling of CSS and XHTML: + * Changed way CSS is provided to enable use of system font and colours. + * Tidied source HTML documents to remove illegal XHTML strict attributes and to remove hard-wired colours. ## Release v1.3.2 of 24 November 2006 -+ Made program remember whether test units are displayed or hidden until end of session. - +* Made program remember whether test units are displayed or hidden until end of session. ## Unreleased v1.3.1 of 21 November 2006 -+ Made minor modification to appearance of Configure Compilers dialogue box. - +* Made minor modification to appearance of Configure Compilers dialogue box. ## Unreleased v1.3 of 18 November 2006 -+ Added facility to sign up to CodeSnip mailing list on-line. -+ Corrected further typos in registration wizard. -+ Updated help file re mailing list sign-up, changed privacy statement and added license to contents page. - +* Added facility to sign up to CodeSnip mailing list on-line. +* Corrected further typos in registration wizard. +* Updated help file re mailing list sign-up, changed privacy statement and added license to contents page. ## Release v1.2.5 of 16 November 2006 -+ Corrected and modified text displayed on last page of Registration Wizard when user elects to join mailing list. - +* Corrected and modified text displayed on last page of Registration Wizard when user elects to join mailing list. ## Unreleased v1.2.4 of 14 November 2006 -+ Changed about box and help menu to display end user license agreement in help file rather than separate text file. -+ Added license topic and made related changes to help file. - +* Changed about box and help menu to display end user license agreement in help file rather than separate text file. +* Added license topic and made related changes to help file. ## Unreleased v1.2.3 of 12 November 2006 -+ Fixed incorrect glyph used for Show All search menu item and tool button. -+ Moved Tools | Preferences menu option to top of Tools menu. - +* Fixed incorrect glyph used for Show All search menu item and tool button. +* Moved Tools | Preferences menu option to top of Tools menu. ## Unreleased v1.2.2 of 12 November 2006 -+ Added hot tracking to tree view check boxes used in Select Routines dialogue box when Windows XP themes are enabled. - +* Added hot tracking to tree view check boxes used in Select Routines dialogue box when Windows XP themes are enabled. ## Unreleased v1.2.1 of 11 November 2006 -+ Refactoring release: - - Method used to construct and use help file changed. - - Moved code that detects HTML and RTF files to appropriate utility units. - - Streamlined code in preview dialogue box. - +* Refactoring release: + * Method used to construct and use help file changed. + * Moved code that detects HTML and RTF files to appropriate utility units. + * Streamlined code in preview dialogue box. ## Release v1.2 of 11 November 2006 -+ Changed syntax highlighter used to format units and code snippets to be able to read custom settings from persistent storage. -+ Added Syntax Highlighter tab to preferences dialogue box to enable users to customise the font, style and colours used by the syntax highlighter. -+ Modified preferences dialogue box's Source Code tab to display a preview of routines using various comment styles. -+ Updated help file re revised preferences dialogue box. - +* Changed syntax highlighter used to format units and code snippets to be able to read custom settings from persistent storage. +* Added Syntax Highlighter tab to preferences dialogue box to enable users to customise the font, style and colours used by the syntax highlighter. +* Modified preferences dialogue box's Source Code tab to display a preview of routines using various comment styles. +* Updated help file re revised preferences dialogue box. ## Unreleased v1.1.2 of 07 November 2006 -+ Refactoring release: - - Added code to generate CSS properties. - - Added new classes to generate RTF code. - - Re-implemented RTF highlighted code. -+ Now generates much smaller RTF export files. - +* Refactoring release: + * Added code to generate CSS properties. + * Added new classes to generate RTF code. + * Re-implemented RTF highlighted code. +* Now generates much smaller RTF export files. ## Unreleased v1.1.1 of 31 October 2006 -+ Changed Select Routines dialogue to use XP style check boxes when XP themes active and custom check boxes when XP themes inactive. - +* Changed Select Routines dialogue to use XP style check boxes when XP themes active and custom check boxes when XP themes inactive. ## Release v1.1 of 30 October 2006 -+ Added ability to generate and save whole Pascal unit containing currently selected routines. -+ Added new search that can find all routines cross-referenced by a given routine. -+ Added ability to manually select routines that are displayed in overview pane. -+ Added short-cut key and changed glyph for File | Save Snippet option / tool button. -+ Updated way source code preferences are stored. Broke backwards compatibility with previous storage method, so upgraders may loose settings. -+ Made minor changes to preferences dialogue box. -+ Word-wrapped long uses lists in generated units. -+ Refactored code that determines type of exported files. -+ Refactored and expanded code that deals with source code exporting. -+ Fixed some minor bugs: - - Previews of large rich text documents were displaying RTF source instead of rendering document. - - Assertion failure could (rarely) happen when displaying message boxes without specifying parent form. - - Saving snippets in a file without supplying a file extension could silently overwrite existing files. - - Comment style was being ignored when generating a unit. -+ Updated help file: - - Added new topics, index entries and TOC entries for new features. - - Updated some existing topics to refer to new features. - - Revised and corrected several existing help topics. - +* Added ability to generate and save whole Pascal unit containing currently selected routines. +* Added new search that can find all routines cross-referenced by a given routine. +* Added ability to manually select routines that are displayed in overview pane. +* Added short-cut key and changed glyph for File | Save Snippet option / tool button. +* Updated way source code preferences are stored. Broke backwards compatibility with previous storage method, so upgraders may loose settings. +* Made minor changes to preferences dialogue box. +* Word-wrapped long uses lists in generated units. +* Refactored code that determines type of exported files. +* Refactored and expanded code that deals with source code exporting. +* Fixed some minor bugs: + * Previews of large rich text documents were displaying RTF source instead of rendering document. + * Assertion failure could (rarely) happen when displaying message boxes without specifying parent form. + * Saving snippets in a file without supplying a file extension could silently overwrite existing files. + * Comment style was being ignored when generating a unit. +* Updated help file: + * Added new topics, index entries and TOC entries for new features. + * Updated some existing topics to refer to new features. + * Revised and corrected several existing help topics. ## Unreleased v1.0.3 of 26 October 2006 -+ Refactored various parts of source code. No changes to program's functionality. Details are: - - Standardised all singleton objects on interface based implementation. - - Centralised code that gets location of license file. - - Standardised links that trigger JavaScript in some HTML resources. - - Changed bug report dialogue box to descend from common wizard dialogue box. - +* Refactored various parts of source code. No changes to program's functionality. Details are: + * Standardised all singleton objects on interface based implementation. + * Centralised code that gets location of license file. + * Standardised links that trigger JavaScript in some HTML resources. + * Changed bug report dialogue box to descend from common wizard dialogue box. ## Release v1.0.2 of 25 October 2006 -+ Changed so that links from program to external web pages display in default browser rather than IE. -+ Refactored code that displays license text file in external application. -+ Reworded some of welcome screen and added links to on-line database. -+ Refactored some JavaScript code that works with main display HTML and web browser code. -+ Made minor changes to hints displayed in status bar when cursor is over links. - +* Changed so that links from program to external web pages display in default browser rather than IE. +* Refactored code that displays license text file in external application. +* Reworded some of welcome screen and added links to on-line database. +* Refactored some JavaScript code that works with main display HTML and web browser code. +* Made minor changes to hints displayed in status bar when cursor is over links. ## Release v1.0.1 of 14 October 2006 -+ Fixed problem in web update that caused program to crash on Windows 9x platforms. - +* Fixed problem in web update that caused program to crash on Windows 9x platforms. ## Release v1.0 of 09 June 2006 -+ Revised About Box text and appearance and added link that displays license file. -+ Refactored and renamed some code. -+ Made minor changes to appearance and effect of Configure Compilers dialogue box. -+ Fixed potential bug displaying JavaScript error dialogue if help called from links in main display fail. -+ Made some literal strings resource strings. -+ Made calls to help system fail gracefully on machines without HTML Help installed. -+ Modified code that reads program's version information. -+ Added important compiler directives. -+ Standardised appearance of all groups of action links in main display. -+ Added Help menu item to display license and to access CodeSnip web page. -+ Moved bug report and registration menu options from Help to Tools menu. -+ Updated and help file re new commands, corrected some errors and re-styled menu help sections. -+ Created installer using Inno Setup. -+ Added new batch file to build program. -+ Fully commented code. -+ Changed to new end user license agreement for the executable program. The program remains open source. - +* Revised About Box text and appearance and added link that displays license file. +* Refactored and renamed some code. +* Made minor changes to appearance and effect of Configure Compilers dialogue box. +* Fixed potential bug displaying JavaScript error dialogue if help called from links in main display fail. +* Made some literal strings resource strings. +* Made calls to help system fail gracefully on machines without HTML Help installed. +* Modified code that reads program's version information. +* Added important compiler directives. +* Standardised appearance of all groups of action links in main display. +* Added Help menu item to display license and to access CodeSnip web page. +* Moved bug report and registration menu options from Help to Tools menu. +* Updated and help file re new commands, corrected some errors and re-styled menu help sections. +* Created installer using Inno Setup. +* Added new batch file to build program. +* Fully commented code. +* Changed to new end user license agreement for the executable program. The program remains open source. ## Release v1.0 RC 3 of 01 May 2006 -_Internal CodeSnip version 0.12.0_ - -+ 3rd release candidate for the v1.0 release. -+ Updated to use v4 of update web service that uses completely new update protocol. Significant changes to code were needed to achieve this. -+ Redesigned update dialogue box accordingly. -+ Added ability to update dialogue to display latest CodeSnip news delivered as part update process. -+ Updated help file re changes to update dialogue box. +Internal CodeSnip version 0.12.0 +* 3rd release candidate for the v1.0 release. +* Updated to use v4 of update web service that uses completely new update protocol. Significant changes to code were needed to achieve this. +* Redesigned update dialogue box accordingly. +* Added ability to update dialogue to display latest CodeSnip news delivered as part update process. +* Updated help file re changes to update dialogue box. ## Release v1.0 RC 2 of 16 April 2006 -_Internal CodeSnip version 0.11.3_ - -+ 2nd release candidate for the v1.0 release. -+ Fixed bug where user could drag and drop files onto web browser controls and file contents would overwrite the display. +Internal CodeSnip version 0.11.3 +* 2nd release candidate for the v1.0 release. +* Fixed bug where user could drag and drop files onto web browser controls and file contents would overwrite the display. ## Release v1.0 RC 1 of 11 April 2006 -_Internal CodeSnip version 0.11.2_ - -+ 1st release candidate for the v1.0 release. -+ Updated help file: - - Ensured that external links display in a web browser window rather than in the help window. - - Added additional internal links to some help topics. -+ Fixed compiler warnings. -+ Removed some redundant code. +Internal CodeSnip version 0.11.2 +* 1st release candidate for the v1.0 release. +* Updated help file: + * Ensured that external links display in a web browser window rather than in the help window. + * Added additional internal links to some help topics. +* Fixed compiler warnings. +* Removed some redundant code. ## Unreleased v0.11.1 Beta of 10 April 2006 -+ Improved and fixed interaction with database update web service: - - Download manager now sends program's key and registration code to web service instead of place-holder strings. - - Handling for HTTP error messages improved. Short HTTP error descriptions are displayed rather than full content of error pages. - +* Improved and fixed interaction with database update web service: + * Download manager now sends program's key and registration code to web service instead of place-holder strings. + * Handling for HTTP error messages improved. Short HTTP error descriptions are displayed rather than full content of error pages. ## Release v0.11.0 Beta of 07 April 2006 -+ Added ability to register CodeSnip at DelphiDabbler.com: - - Registration is performed via a new wizard that gathers registration information and interacts with web server. - - Wizard is accessed via a Help menu option and About box button that appear only when application is unregistered. - - Application is identified by a unique key. - - Registration information is stored in persistent storage. -+ Reworked and added classes to centralise access to system and application information. -+ Updated help file with details of registration dialogue and CodeSnip mailing list. - +* Added ability to register CodeSnip at DelphiDabbler.com: + * Registration is performed via a new wizard that gathers registration information and interacts with web server. + * Wizard is accessed via a Help menu option and About box button that appear only when application is unregistered. + * Application is identified by a unique key. + * Registration information is stored in persistent storage. +* Reworked and added classes to centralise access to system and application information. +* Updated help file with details of registration dialogue and CodeSnip mailing list. ## Unreleased v0.10.12 Beta of 04 April 2006 -+ Improved code that stores global application settings. Prepared way for having per-user and global settings rather than just per-user settings as at present. - +* Improved code that stores global application settings. Prepared way for having per-user and global settings rather than just per-user settings as at present. ## Unreleased v0.10.11 Beta of 03 April 2006 -+ Revised to work with v3.1 of CodeSnip database update web service. - +* Revised to work with v3.1 of CodeSnip database update web service. ## Unreleased v0.10.10 Beta of 02 April 2006 -+ Added program icon (16x16, 32x32 and 48x48 versions). - +* Added program icon (16x16, 32x32 and 48x48 versions). ## Release v0.10.9 Beta of 02 April 2006 -+ Fixed bug where browser controls displayed JavaScript error dialogue when exceptions were raised by database updates initiated from browser control's "external" object. -+ Refactored some code in main form and main snippets object as a result of above fix. -+ Also refactored some of search code in main form. - +* Fixed bug where browser controls displayed JavaScript error dialogue when exceptions were raised by database updates initiated from browser control's "external" object. +* Refactored some code in main form and main snippets object as a result of above fix. +* Also refactored some of search code in main form. ## Unreleased v0.10.8 Beta of 02 April 2006 -+ Removed bug in database update manager that was causing database to be restored unnecessarily. -+ Heavily refactored update manager code as part of bug fix. - +* Removed bug in database update manager that was causing database to be restored unnecessarily. +* Heavily refactored update manager code as part of bug fix. ## Release v0.10.7 Beta of 28 January 2006 -+ Fixed display problems in details pane when running on Windows 2000. -+ Changed style of scroll bars from flat to normal when running in Windows XP classic style or on earlier Windows version. -+ Made compiler check pane update itself when compilers are added or removed. - +* Fixed display problems in details pane when running on Windows 2000. +* Changed style of scroll bars from flat to normal when running in Windows XP classic style or on earlier Windows version. +* Made compiler check pane update itself when compilers are added or removed. ## Release v0.10.6 Beta of 20 January 2006 -+ Fixed bug where backup directory was not being deleted after database updates. - +* Fixed bug where backup directory was not being deleted after database updates. ## Release v0.10.5 Beta of 14 January 2006 -+ Added credits for third party code to about box. -+ Completed help file. - +* Added credits for third party code to about box. +* Completed help file. ## Release v0.10.4 Beta of 12 January 2006 -+ Added checking of checksums of downloaded files to increase security. Exceptions now raised when a file's checksum is incorrect. -+ Fixed small alignment problem in update dialogue. - +* Added checking of checksums of downloaded files to increase security. Exceptions now raised when a file's checksum is incorrect. +* Fixed small alignment problem in update dialogue. ## Unreleased v0.10.3 Beta of 11 January 2006 -+ Changed so that compiler output is now captured directly rather than via temporary log file. -+ Compiler execution is now time-sliced and time-limited rather than being allowed infinite processing time. - +* Changed so that compiler output is now captured directly rather than via temporary log file. +* Compiler execution is now time-sliced and time-limited rather than being allowed infinite processing time. ## Unreleased v0.10.2 Beta of 10 January 2006 -+ Reverted to Delphi 7 to avoid Delphi 2006 bug that was enabling dialogues to be minimized and maximized. -+ Reordered controls in Find Compiler dialogues. -+ Restored title bar close button to web update dialogue. -+ Reverted to Indy 9 Internet controls (from Indy 10) and made relevant adjustments to code. -+ Completed help topics for Find Text and Find Compiler dialogues. - +* Reverted to Delphi 7 to avoid Delphi 2006 bug that was enabling dialogues to be minimized and maximized. +* Reordered controls in Find Compiler dialogues. +* Restored title bar close button to web update dialogue. +* Reverted to Indy 9 Internet controls (from Indy 10) and made relevant adjustments to code. +* Completed help topics for Find Text and Find Compiler dialogues. ## Release v0.10.1 Beta of 09 January 2006 -+ Removed debug code (message box) mistakenly left in compiler execution code. -+ Refactored compiler support classes. - +* Removed debug code (message box) mistakenly left in compiler execution code. +* Refactored compiler support classes. ## Release v0.10.0 Beta of 08 January 2006 -+ Added support for Delphi 2005/6 Win32 compilers. -+ Refactored some compiler support code. -+ Added support for user-configurable compiler switches. -+ Used new tabbed layout for Configure Compilers dialogue box and added tab for configuring compiler switches. -+ Updated help file to reflect redesign of Configure Compilers dialogue box. - +* Added support for Delphi 2005/6 Win32 compilers. +* Refactored some compiler support code. +* Added support for user-configurable compiler switches. +* Used new tabbed layout for Configure Compilers dialogue box and added tab for configuring compiler switches. +* Updated help file to reflect redesign of Configure Compilers dialogue box. ## Release v0.9.0 Beta of 06 January 2006 -+ Added facility to copy code snippets to clipboard. -+ Added new preferences dialogue box to enable configuration of default format for code snippets. -+ Added new preferences class to persist data entered in the preferences dialogue. -+ Refactored main snippets class to simplify addition of new copy snippet facility. -+ Updated help file re new additions. - +* Added facility to copy code snippets to clipboard. +* Added new preferences dialogue box to enable configuration of default format for code snippets. +* Added new preferences class to persist data entered in the preferences dialogue. +* Refactored main snippets class to simplify addition of new copy snippet facility. +* Updated help file re new additions. ## Unreleased v0.8.3 Beta of 04 January 2006 -+ Modified to compile with Indy Components v10 and Delphi 2006 for Win 32. - +* Modified to compile with Indy Components v10 and Delphi 2006 for Win 32. ## Unreleased v0.8.2 Beta of 04 January 2006 -+ Created static class to interpret command line and changed other code to work with the new class. - +* Created static class to interpret command line and changed other code to work with the new class. ## Unreleased v0.8.1 Beta of 04 January 2006 -+ Fixed minor display bug in web update dialogue box. -+ Fixed about box's problem in displaying help in response to F1 key press. - +* Fixed minor display bug in web update dialogue box. +* Fixed about box's problem in displaying help in response to F1 key press. ## Release v0.8.0 Beta of 30 November 2005 -+ Changed help file from WinHelp (.hlp) format to HTML Help (.chm) format. -+ Changed program to use new format help file. - +* Changed help file from WinHelp (.hlp) format to HTML Help (.chm) format. +* Changed program to use new format help file. ## Release v0.7.7 Beta of 22 November 2005 -+ Refactored and revised code that accesses DelphiDabbler web services. -+ Updated to use v2 of the database update web service. -+ Added topics for Bug Report dialogue and Web Update dialogue to help file. - +* Refactored and revised code that accesses DelphiDabbler web services. +* Updated to use v2 of the database update web service. +* Added topics for Bug Report dialogue and Web Update dialogue to help file. ## Release v0.7.6 Beta of 04 June 2005 -+ Fixed Delphi compiler auto-detection bug. -+ Fixed bug that caused endless loop of exceptions when "database" was corrupt. -+ Syntax highlighter now generates correct XHTML for multi-line comments and generates correct CSS for mono-spaced fonts. -+ Occasional failure to create compiler log files now reported as error rather than bug. - +* Fixed Delphi compiler auto-detection bug. +* Fixed bug that caused endless loop of exceptions when "database" was corrupt. +* Syntax highlighter now generates correct XHTML for multi-line comments and generates correct CSS for mono-spaced fonts. +* Occasional failure to create compiler log files now reported as error rather than bug. ## Release v0.7.5 Beta of 03 June 2005 -+ Fixes bugs that surface when user has disabled scripts in IE's Internet zone. Program no longer runs in Internet zone. - +* Fixes bugs that surface when user has disabled scripts in IE's Internet zone. Program no longer runs in Internet zone. ## Release v0.7.4 Beta of 09 May 2005 -+ Made user defined settings in Save Snippets dialogue box persistent. - +* Made user defined settings in Save Snippets dialogue box persistent. ## Unreleased v0.7.3 Beta of 25 April 2005 -+ Disabled test compile button on compiler checks pane along with associated menu and toolbar button when no compilers installed. -+ Rewrote main welcome page, adding links to compiler check dialogue. Made same welcome page appear in both detail panes. -+ Updated compiler check pages by adding links to compiler check dialogue and new "about compiler checks" help topic. -+ Updated help file with new "about compiler checks" topic and completed "QuickStart" topic. -+ Added new features to DOM's external object to support above changes. - +* Disabled test compile button on compiler checks pane along with associated menu and toolbar button when no compilers installed. +* Rewrote main welcome page, adding links to compiler check dialogue. Made same welcome page appear in both detail panes. +* Updated compiler check pages by adding links to compiler check dialogue and new "about compiler checks" help topic. +* Updated help file with new "about compiler checks" topic and completed "QuickStart" topic. +* Added new features to DOM's external object to support above changes. ## Unreleased v0.7.2 Beta of 21 April 2005 -+ Refactored code that maintains persistent application data. -+ Refactored syntax highlighter code and moved interfaces and enumerated types to own unit. -+ Renamed unit generation unit now that it generates source code other than complete units. -+ Carried out minor refactoring of Pascal analyser unit. - +* Refactored code that maintains persistent application data. +* Refactored syntax highlighter code and moved interfaces and enumerated types to own unit. +* Renamed unit generation unit now that it generates source code other than complete units. +* Carried out minor refactoring of Pascal analyser unit. ## Unreleased v0.7.1 Beta of 20 April 2005 -+ Disabled F1 key press handling in dialogues with no help button. Was triggering bad topic errors in WinHelp. -+ Added "Compile" prefix to compiler check page's "Test Compile" button. -+ Fixed errors in "do nothing" doc host handler used by web browser control. - +* Disabled F1 key press handling in dialogues with no help button. Was triggering bad topic errors in WinHelp. +* Added "Compile" prefix to compiler check page's "Test Compile" button. +* Fixed errors in "do nothing" doc host handler used by web browser control. ## Release v0.7.0 Beta of 17 March 2005 -+ Added new facility to save a routine, or a whole category of routines, to file. -+ Reworked syntax highlighter implementation. -+ Updated help file with details of new routine saving feature. - +* Added new facility to save a routine, or a whole category of routines, to file. +* Reworked syntax highlighter implementation. +* Updated help file with details of new routine saving feature. ## Release v0.6.0 Beta of 10 March 2005 -+ Added syntax highlighting for source code displayed in detail panes. - +* Added syntax highlighting for source code displayed in detail panes. ## Release v0.5.0 Beta of 05 March 2005 -+ Added support for Free Pascal compiler by totally reworking the compiler support engine. -+ Added new dialogue box to configure compilers. Compiler detection ability retained but now only works in response to user request. -+ Revised about box to include "powered by Delphi" logo. -+ Updated help file: - - Added incomplete topics for each of the main menus. - - Added complete new topic for the compiler configuration dialogue box. - - Fixed K-keyword errors and added extra keywords for dialogue boxes. - +* Added support for Free Pascal compiler by totally reworking the compiler support engine. +* Added new dialogue box to configure compilers. Compiler detection ability retained but now only works in response to user request. +* Revised about box to include "powered by Delphi" logo. +* Updated help file: + * Added incomplete topics for each of the main menus. + * Added complete new topic for the compiler configuration dialogue box. + * Fixed K-keyword errors and added extra keywords for dialogue boxes. ## Release v0.4.0 Beta of 28 February 2005 -+ Text search results are now highlighted when routines are displayed in the information pane. - +* Text search results are now highlighted when routines are displayed in the information pane. ## Unreleased v0.3.4 Beta of 26 February 2005 -+ Separated back end database code from Snippets object. -+ New back end code designed to make it easy to change the data provider in future versions. Current version accesses data in .ini and .dat files. - +* Separated back end database code from Snippets object. +* New back end code designed to make it easy to change the data provider in future versions. Current version accesses data in .ini and .dat files. ## Unreleased v0.3.3 Beta of 25 February 2005 -+ Fixed bug that was preventing Ctrl+F from activating Find Text dialogue box. -+ Realigned controls in bug report dialogue and fixed tab order problems. -+ Fixed email address validation error in bug report dialogue - +* Fixed bug that was preventing Ctrl+F from activating Find Text dialogue box. +* Realigned controls in bug report dialogue and fixed tab order problems. +* Fixed email address validation error in bug report dialogue ## Unreleased v0.3.2 Beta of 24 February 2005 -+ Refactored code that provides compiler names and introduced global Compilers object. - +* Refactored code that provides compiler names and introduced global Compilers object. ## Unreleased v0.3.1 Beta of 24 February 2005 -+ Centralised code that displays message dialogues and standardised their appearance. - +* Centralised code that displays message dialogues and standardised their appearance. ## Unreleased v0.3.0 Beta of 23 February 2005 -+ Updated welcome pages to provide more help on using CodeSnip. -+ Removed dialogues that appeared on start up when database was empty. Welcome page now provides this information along with an option to download database. -+ Improved handling of welcome page. - +* Updated welcome pages to provide more help on using CodeSnip. +* Removed dialogues that appeared on start up when database was empty. Welcome page now provides this information along with an option to download database. +* Improved handling of welcome page. ## Unreleased v0.2.4 Beta of 23 February 2005 -+ Refactored and simplified access to dialogue boxes. -+ Improved search code. - +* Refactored and simplified access to dialogue boxes. +* Improved search code. ## Unreleased v0.2.3 Beta of 23 February 2005 -+ Created a class hierarchy for all frames that display HTML in a web browser control. - +* Created a class hierarchy for all frames that display HTML in a web browser control. ## Unreleased v0.2.2 Beta of 22 February 2005 -+ Localised various literal strings and moved some constant values to a common location. - +* Localised various literal strings and moved some constant values to a common location. ## Unreleased v0.2.1 Beta of 22 February 2005 -+ Overhauled web browser external object extender that communicates browser events to application. -+ Added new notifier object that centralises handling of GUI user interaction. - +* Overhauled web browser external object extender that communicates browser events to application. +* Added new notifier object that centralises handling of GUI user interaction. ## Unreleased v0.2.0 Beta of 21 February 2005 -+ Made minor changes to appearance of main display. -+ Refactored the HTML generation engine, added several HTML templates to resources and localised all strings used in generated HTML. - +* Made minor changes to appearance of main display. +* Refactored the HTML generation engine, added several HTML templates to resources and localised all strings used in generated HTML. ## Unreleased v0.1.4 Beta of 19 February 2005 -+ Refactored some code. - +* Refactored some code. ## Unreleased v0.1.3 Beta of 18 February 2005 -+ Removed redundant code. - +* Removed redundant code. -##Unreleased v0.1.2 Beta of 18 February 2005 - -+ Removed debug code. +## Unreleased v0.1.2 Beta of 18 February 2005 +* Removed debug code. ## Unreleased v0.1.1 Beta of 18 February 2005 -+ Fixed minor bugs. - +* Fixed minor bugs. ## Release v0.1.0 Beta of 30 January 2005 -+ Original beta release. +* Original beta release. diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 000000000..8531ff7e8 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,195 @@ +# Contributing + +Thanks for you interest in contributing to the CodeSnip project. + +## Contents + +* [Overview](#overview) +* [Issues](#issues) +* [Documentation](#documentation) +* [Coding](#coding) +* [About Pull Requests](#about-pull-requests) +* [Licensing of Contributions](#licensing-of-contributions) +* [Code of Conduct](#code-of-conduct) +* [Attributions](#attributions) + +## Overview + +Contributions of all kinds are more than welcome. + +> 💡 You will need a GitHub account to be able to make contributions. [Sign up here](https://docs.github.com/en/get-started/signing-up-for-github/signing-up-for-a-new-github-account). + +There three main ways in which you can contribute, each of which is explained in its own section below. From easiest to hardest, they are: + +* [Issues](#issues) - report bugs and request new features. +* [Documentation](#documentation) - improve the project's documentation. +* [Coding](#coding) - modify the project's source code. + +Regardless of how you choose to contribute, please respect the project's [code of conduct](#code-of-conduct). + +## Issues + +The easiest way to make a contribution is to [create an issue](https://github.com/delphidabbler/codesnip/issues/new). + +You can use issues to: + +1. [Report a bug](#reporting-a-bug) +2. [Request a new program feature](#requesting-a-new-feature) +3. [Suggest changes to documentation](#suggesting-documentation-changes) + +It is helpful if you perform a cursory search of [existing issues](https://github.com/delphidabbler/codesnip/issues?q=is%3Aissue) to see if there is already a similar issue. If so then please add your thoughts as comments on that issue rather than open a new one. + +### Reporting a bug + +Before reporting a bug please make sure the bug exists in the [latest release](https://github.com/delphidabbler/codesnip/releases) of CodeSnip 4. + +To report a bug please provide as much information about the bug as possible, including the program's version number, what happened, what you expected to happen and what you were doing at the time. If possible, explain how to reproduce the bug. + +> 💡 You can find CodeSnip's version number in the program's About box (_Help | About_ menu option). + +If you have resolved an issue yourself please consider contributing your fix so that others can benefit from your work. Please read the [Coding](#coding) section before doing so. + +### Requesting a new feature + +If you think of a feature that you would like to see added to CodeSnip you can open an issue to request it. + +Please be as clear as possible about what you expect the feature to do and why you want it. + +Ideas about how to implement the feature are welcome. Even better, if you have implemented the feature yourself, you may be able to contribute the code. But please read the [Coding](#coding) section before doing so. + +### Suggesting documentation changes + +The third reason to create an issue is if you want to suggest new documentation or ammendments to existing documentation. + +There are two types of documentation within the CodeSnip repository. Firstly, there is general documentation that can be found in the [repository root](https://github.com/delphidabbler/codesnip/tree/develop) and in the [`Docs`](https://github.com/delphidabbler/codesnip/tree/develop/Docs) directory. Secondly, there are numerous HTML help files in the [`Src/Help/HTML`](https://github.com/delphidabbler/codesnip/tree/develop/Src/Help/HTML) directory. + +If you have written or corrected some documentation yourself please consider submitting it. See the [Documentation](#documentation) section below to find out how to do this. + +## Documentation + +Writing and editing documentation is a relatively easy way to start contributing. Providing simple clear or helpful documentation for users is critical. Things that *you* found hard to understand as a user, or difficult to work out, are excellent places to begin. + +There are two ways to contribute documentation. The preferred method is by means of a [pull request](#about-pull-requests). But, you can simply create an issue and attach documentation files to the issue comments. This approach is perfectly acceptable for a small number of files, and saves you having to install Git! + +## Coding + +Code contributions to the [CodeSnip 4 development tree](https://github.com/delphidabbler/codesnip/tree/develop) are always welcome, from fixing bugs to developing new features. + +> 😠Before going any further, let's address the elephant in the room. CodeSnip has to be compiled with the now rather ancient Delphi XE. It would be much better if development could move to a more recent version of Delphi, but that's proving to be extremely problematic. See [this FAQ](https://github.com/delphidabbler/codesnip-faq/blob/master/SourceCode.md#faq-11) for an explanation. + +If you're still here, you will need to set up a valid build environment in order to compile CodeSnip from source. [`Build.html`](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/develop/Build.html) tells you everything you need to know about configuring the environment, the tools you will need, and how compile CodeSnip using the provided `Makefile`. + +> 💡 Need ideas? You can [browse open issues](https://github.com/delphidabbler/codesnip/issues) and see if you can help with any of them. + +Contributions should normally be made using [pull requests](#about-pull-requests). + +But, if you have just a few lines of code to suggest it _may_ be possible to accept the code within (or attached to) a comment on an issue. If in doubt, ask first by means of a comment. When including the code in a comment, please use [GitHub code fencing](https://docs.github.com/en/get-started/writing-on-github/working-with-advanced-formatting/creating-and-highlighting-code-blocks) to format the code and make it easier to read. For example: + + ```pascal + procedure TFoo.CoolNewMethod; + begin + // cool code here + end; + ``` + +## About Pull Requests + +All pull requests *must* relate to an [open _accepted_ issue](https://github.com/delphidabbler/codesnip/issues?q=is%3Aissue+label%3Aaccepted++is%3Aopen+) on GitHub. + +If you wish to contribute code for which there is no existing issue you can create one. Please wait for the issue to be accepted by the project owner before submitting your pull request. Acceptance is indicated by attaching an "accepted" label to the issue and is signed off by means of a comment on the issue from the project owner. + +> 💡 Should you get stuck at any point please ask for help by leaving a comment on the relevant issue. + +Before you can start you need to get the source code. Here's how: + +1. Fork the CodeSnip project into your own GitHub repository. + + â­***Important***â­ _Ensure that all remote branches are included in the fork_, not just `master`. On GitHub this means clearing the "Copy the `master` branch only" check box before creating the fork. + +2. Clone the forked repository onto your own system using: + + $ git clone https://github.com/<account>/codesnip.git + + where `<account>` is your GitHub user account ID. + +CodeSnip uses the [Git Flow](https://nvie.com/posts/a-successful-git-branching-model/) methodology. This means that you need to create your source code on a "feature" branch off the `develop` branch. Here's how: + +1. Pull the `develop` branch from your forked repository, and switch into it: + + $ git pull origin develop + $ git switch develop + +2. Create and switch to a new feature branch, branched off `develop`. + + Name the branch `feature/` followed by the issue number to which it relates. Appending a hyphen followed by a brief description is useful too. Example branch names are `feature/42-fix-ui-bug` or `feature/56`: + + $ git branch feature/42-fix-ui-bug + $ git switch feature/42-fix-ui-bug + +3. Make your changes, whether to source code or documentation, and commit them to your feature branch. Clarity is prefered to terseness in commit messages. Please don't squash logically unrelated commits. + +4. If you are editing source code you need to ensure that it compiles and works as expected. + + > 💡 Having trouble? Please make sure you have read [`Build.html`](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/develop/Build.html). If that doesn't solve your problem then ask for help by creating a comment on the relevant issue. + +Once you have finished writing the code and are ready to submit it you need to prepare your forked repository: + +1. Use GitHub to ensure that the `develop` branch of your fork is up to date with the parent `delphidabbler/codesnip` repository's `develop` branch. + +2. Rebase your changes onto your forked repository's remote `develop` branch: + + $ git rebase origin/develop feature/42-fix-ui-bug + +3. Resolve any conflicts arising from the rebase then push your changes to your forked repository: + + $ git push origin feature/42-fix-ui-bug + +You are finally ready to open that pull request. Proceed as follows: + +1. Open your forked repository on GitHub. You should see a banner saying something like "feature/42-fix-ui-bug had recent pushes ..." along with a button that says "Compare and Pull Request". Click that button. + +2. You will be taken the "Comparing Changes" page on `delphidabbler/codesnip`. + + â­***Important***â­ Just below the page title is a line of drop-down buttons where you choose what to compare. Check the caption of the 2nd button from the left. If it reads anything other than "base: `develop`" (and it probably doesn't) then click the button and select `develop` from the list of branches that is displayed. + + > âš ï¸ Pull requests based on `master`, or any branch other than `develop`, will not be accepted. + +3. Now complete the form and click the "Create Pull Request" button. + +That's it. + +Sit back and wait. Either your pull request will be accepted or you will receive comments requesting clarification or changes. + +Once your pull request is accepted you can delete the feature branch from both your local and forked remote fork. + +## Licensing of Contributions + +The license that applies to any existing file you edit will continue to apply to the edited file. Any existing license text or copyright statement **must not** be altered or removed, but you can add your own copyright line if desired. + +Any new file you contribute **must** either be licensed under the [Mozilla Public License v2.0](https://www.mozilla.org/MPL/2.0/) (MPL2) or have a license compatible with the MPL2. If a license is not specified then MPL2 will be assumed and will be applied to the file. You should insert a suitable copyright statement in the file. + +Any third party code used by your contributed code **must** also have a license compatible with the MPL2. + +> 💡 MPL2 boilerplate text, in several programming language's comment formats, can be found in the file [`Docs/MPL-2.0-Boilerplate.txt`](https://raw.githubusercontent.com/delphidabbler/codesnip/master/Docs/MPL-2.0-Boilerplate.txt). You will need to change the name of the copyright holder. + +## Code of Conduct + +This is a simple and straightforward code of conduct. What it boils down to is that if you're a decent person you're more than welcome here. Hateful, abusive and just plain rude people are not. + +To be more precise, anyone who contributes to the CodeSnip project is expected to display respect, empathy and politeness towards others. + +Certain behaviours will not be tolerated, and will result in an immediate ban. They are: + +* Racism and hate speech in any form. +* The use of sexualized language or imagery, and sexual attention or advances of any kind. +* Intolerance towards people of any religion or none. +* Trolling, insulting or derogatory comments, and personal or political attacks. +* Public or private harassment. +* Publishing others' private information, such as a physical or email address, without their explicit permission. +* Other conduct which could reasonably be considered inappropriate in a professional setting. + +## Attributions + +1. The list of unacceptable behaviours in the Code of Conduct was taken, in part, from the "Our Standards" section of the [Contributor Covenant Code of Conduct v2.1](https://www.contributor-covenant.org/version/2/1/code_of_conduct/). + +2. Some of the content of this document was inspired by and/or copied from the [Stumpy Contributing Guide](https://stumpy.readthedocs.io/en/latest/Contribute.html). \ No newline at end of file diff --git a/Deploy.bat b/Deploy.bat new file mode 100644 index 000000000..23d95a425 --- /dev/null +++ b/Deploy.bat @@ -0,0 +1,99 @@ +:: This Source Code Form is subject to the terms of the Mozilla Public License, +:: v. 2.0. If a copy of the MPL was not distributed with this file, You can +:: obtain one at https://mozilla.org/MPL/2.0/ +:: +:: Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). +:: +:: Deploy script for CodeSnip. +:: +:: This script compiles release versions of the standard and portable editions +:: of CodeSnip and places them into two different zip files ready for release. +:: +:: This script uses Embarcadero Make. Various other programs are required to +:: run Make. See Src/Makefile for details. +:: +:: To use the script: +:: 1) Set the environment variables required for Make to succeed. See +:: Src/Makefile for details +:: 2) Change directory to that where this script is located. +:: 3) Run the script. +:: +:: Usage: +:: Deploy <version> +:: where +:: <version> is the version number of the release, e.g. 0.5.3-beta or 1.2.0. + +@echo off + +setlocal + +:: Check for required parameter +if "%1"=="" goto paramerror + +:: Store parameter +set Version=%1 + +:: Store common make parameters +set CommonParams=-DVERSION=%Version% + +:: Store standard edition make parameters +set StandardParams=%CommonParams% + +:: Store portable edition make parameters +set PortableParams=-DPORTABLE %CommonParams% + +:: Set command line +set MakeCmd=Make +set StandardMakeCmd=%MakeCmd% %StandardParams% +set PortableMakeCmd=%MakeCmd% %PortableParams% + +echo ---------------------------------------------- +echo Deploying CodeSnip Standard And Portable Builds +echo ----------------------------------------------- +echo. +echo Standard edition Make command: %StandardMakeCmd% +echo Portable edition Make command: %PortableMakeCmd% + +cd Src + +echo. +echo. +echo. +echo ========================= +echo Building Standard edition +echo ========================= +echo. +echo. +%StandardMakeCmd% + +echo. +echo. +echo. +echo ========================= +echo Building Portable edition +echo ========================= +echo. +echo. +%PortableMakeCmd% + +echo. +echo. +echo. +echo ==================== +echo Deployment completed +echo ==================== + +goto end + +:: Error messages + +:paramerror +echo. +echo ***ERROR: Please specify a version number as a parameter +echo. +goto end + +:: End +:end + +endlocal diff --git a/Docs/Design/FileFormats/backup.html b/Docs/Design/FileFormats/backup.html index 90a09893a..1e2752961 100644 --- a/Docs/Design/FileFormats/backup.html +++ b/Docs/Design/FileFormats/backup.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2021, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Backup Files. --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> diff --git a/Docs/Design/FileFormats/config.html b/Docs/Design/FileFormats/config.html index a508a2b24..9ff1ded44 100644 --- a/Docs/Design/FileFormats/config.html +++ b/Docs/Design/FileFormats/config.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2023, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Configuration Files --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> @@ -167,7 +167,7 @@ <h3> </p> <p> - There have been several versions of this file. The current one is version 16. The change to version 16 came with CodeSnip v4.16.0 and the removal of DelphiDabbler web service support. + There have been several versions of this file. The current one is version 20. The change to version 20 came with CodeSnip v4.26.0 and the addition of the <code class="key">UseCommentsInUnitImpl</code> key in the <code>[Prefs:SourceCode]</code> section. </p> <p> @@ -256,6 +256,15 @@ <h4> <li> <em>D104S</em> – Delphi 10.4 Sydney </li> + <li> + <em>D11A</em> – Delphi 11.x Alexandria + </li> + <li> + <em>D12Y</em> – Delphi 12 Athens + </li> + <li> + <em>D13F</em> – Delphi 13 Florence + </li> <li> <em>FPC</em> – Free Pascal </li> @@ -330,8 +339,49 @@ <h4> Each entry contains a fully specified directory path. </div> </dd> + <dt> + <code class="key">CanAutoInstall</code> (Boolean) + </dt> + <dd> + <div class="half-spaced"> + Determines whether the compiler can be automatically detected and registered by CodeSnip. + </div> + <div class="half-spaced"> + Applies to Delphi compilers only, not to Free Pascal. + </div> + </dd> +</dl> + +<h4> + [Compilers] section +</h4> + +<p> + This section records configuration information that applies to all, or + multiple, compilers. +</p> + +<p> + Name / Value pairs: +</p> + +<dl class="indent"> + <dt> + <code class="key">PermitStartupDetection</code> (Boolean) + </dt> + <dd> + <div class="half-spaced"> + Determines whether CodeSnip should detect, and potentially register, any + Delphi compilers that are installed on the user's system but not + registered with the program. + </div> + <div class="half-spaced"> + Does not apply to the Free Pascal compiler. + </div> + </dd> </dl> + <h4> [Database] section </h4> @@ -563,6 +613,24 @@ <h4> <dd> Indicates whether Delphi 10.4 Sydney was included in the search. </dd> + <dt> + <code class="key">D11A</code> (Boolean) + </dt> + <dd> + Indicates whether Delphi 11.x Alexandria was included in the search. + </dd> + <dt> + <code class="key">D12Y</code> (Boolean) + </dt> + <dd> + Indicates whether Delphi 12 Athens was included in the search. + </dd> + <dt> + <code class="key">D13F</code> (Boolean) + </dt> + <dd> + Indicates whether Delphi 13 Florence was included in the search. + </dd> <dt> <code class="key">FPC</code> (Boolean) </dt> @@ -712,7 +780,7 @@ <h4> The version number of the config file. Incremented whenever the file format changes. If this section or this value is missing then the default value is <code class="value">1</code>. </div> <div class="half-spaced"> - The current value is <code class="value">16</code>. + The current value is <code class="value">20</code>. </div> </dd> <dt> @@ -723,6 +791,27 @@ <h4> </dd> </dl> +<h4> + [Prefs] section +</h4> + +<p> + Stores information about the Preferences dialogue box itself, rather than actual preferences data. Actual preference data is stored in sections with names like [Prefs:XXX] where XXX is a preferences sub-section. +</p> + +<p> + Name / Value pairs: +</p> + +<dl class="indent"> + <dt> + <code class="key">LastTab</code> (string) + </dt> + <dd> + Name of the tab that was open when the dialogue box was last closed. May be the empty string if the dialogue box has not yet been opened. + </dd> +</dl> + <h4> [Prefs:CodeGen] section </h4> @@ -883,6 +972,18 @@ <h4> The value is a definition of a custom colour in the format used by the <var>TColorDialog</var> dialogue box. This format is <code class="value">ColourID=ColourNum</code> where <em>ColourID</em> is a value from <code class="value">ColorA</code> to <code class="value">ColorP</code> and <em>ColourNum</em> is the hex representation of the colour. </div> </dd> + <dt> + <code class="key">OverviewFontSize</code> (Integer) + </dt> + <dd> + Size of font to be used in overview pane tree view. If missing or empty the default value is the default font size of the operationg system. + </dd> + <dt> + <code class="key">DetailFontSize</code> (Integer) + </dt> + <dd> + Size of font to be used in detail pane for all text except for source code. If missing or empty the default value is the default content font size of the operating system. + </dd> </dl> <h4> @@ -1170,6 +1271,12 @@ <h4> <dd> Flag indicating whether multi-paragraph snippet descriptions are to be truncated to the first paragraph only in documentation comments. <code class="value">True</code> ⇒ truncate the description; <code class="value">False</code> ⇒ use the full description. </dd> + <dt> + <code class="key">UseCommentsInUnitImpl</code> (Boolean) + </dt> + <dd> + Flag indicating whether source code comments are repeated in a generated unit's implementation section. <code class="value">True</code> ⇒ emit comments in both the interface and implementation sections; <code class="value">False</code> ⇒ emit comments in the interface section only. + </dd> <dt> <code class="key">UseSyntaxHiliting</code> (Boolean) </dt> diff --git a/Docs/Design/FileFormats/export.html b/Docs/Design/FileFormats/export.html index 4313509d3..915b8d6ca 100644 --- a/Docs/Design/FileFormats/export.html +++ b/Docs/Design/FileFormats/export.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2025, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Export --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> @@ -41,6 +41,37 @@ <h1> Export Files </h1> +<section id="contents"> + +<h2> + Contents +</h2> + +<ul> + <li> + <a href="#intro">Introduction</a> + </li> + <li> + <a href="#encoding">Encoding</a> + </li> + <li> + <a href="#file-format">File Format</a> + </li> + <li> + <a href="#erratum">Erratum</a> + </li> + <li> + <a href="#changelog">Change Log</a> + </li> + <li> + <a href="#file-readers">Notes For File Readers</a> + </li> +</ul> + +</section> + +<section id="intro"> + <h2> Introduction </h2> @@ -55,6 +86,10 @@ <h2> these is explained below. </p> +</section> + +<section id="encoding"> + <h2> Encoding </h2> @@ -73,13 +108,17 @@ <h2> this attribute. </p> +</section> + +<section id="file-format"> + <h2> File Format </h2> <p> - There have been seven different versions of the XML export file format – v1 to - v7. Tags used by all versions are explained below, with notes describing + There have been eight different versions of the XML export file format – v1 to + v8. Tags used by all versions are explained below, with notes describing which versions a tag applies to. Where there is no note the tag is valid in all versions. </p> @@ -108,7 +147,7 @@ <h2> </div> <ul class="squashed"> <li> - <span class="highlight">versions 1..4:</span> Attribute not + <span class="highlight">versions 1 to 4:</span> Attribute not provided. </li> <li> @@ -139,8 +178,8 @@ <h2> <em>version</em> </dt> <dd> - Identifies version of file. Determines which tags are valid and - establishes rules concerning content. Valid versions are 1..7. + Identifies major version of file. Determines which tags are valid and + establishes rules concerning content. Valid versions are 1 to 8. </dd> </dl> </dd> @@ -159,10 +198,10 @@ <h2> <dd> <ul class="squashed"> <li> - <span class="highlight">versions 1..6:</span> Contains information about user who created the file   used for submissions to the online database, omitted for other exports. + <span class="highlight">versions 1 to 6:</span> Contains information about user who created the file   used for submissions to the online database, omitted for other exports. </li> <li> - <span class="highlight">version 7:</span> Not supported. Ignored if present. + <span class="highlight">version 7 and later:</span> Not supported. Ignored if present. </li> </ul> </dd> @@ -173,10 +212,10 @@ <h2> <dd> <ul class="squashed"> <li> - <span class="highlight">versions 1..6:</span> User's name or nickname. + <span class="highlight">versions 1 to 6:</span> User's name or nickname. </li> <li> - <span class="highlight">version 7:</span> Not supported. Ignored if present. + <span class="highlight">version 7 and later:</span> Not supported. Ignored if present. </li> </ul> </dd> @@ -187,10 +226,10 @@ <h2> <dd> <ul class="squashed"> <li> - <span class="highlight">versions 1..6:</span> User's email address. + <span class="highlight">versions 1 to 6:</span> User's email address. </li> <li> - <span class="highlight">version 7:</span> Not supported. Ignored if present. + <span class="highlight">version 7 and later:</span> Not supported. Ignored if present. </li> </ul> </dd> @@ -201,10 +240,10 @@ <h2> <dd> <ul class="squashed"> <li> - <span class="highlight">versions 1..6:</span> Any comments provided by user. + <span class="highlight">versions 1 to 6:</span> Any comments provided by user. </li> <li> - <span class="highlight">version 7:</span> Not supported. Ignored if present. + <span class="highlight">version 7 and later:</span> Not supported. Ignored if present. </li> </ul> </dd> @@ -234,7 +273,7 @@ <h2> </div> <ul class="squashed"> <li> - <span class="highlight">versions 1..4:</span> Name must begin with + <span class="highlight">versions 1 to 4:</span> Name must begin with an English language letter or the underscore. </li> <li> @@ -256,13 +295,21 @@ <h2> </div> <ul class="squashed"> <li> - <span class="highlight">versions 1..5:</span> Content is a single line + <span class="highlight">versions 1 to 5:</span> Content is a single line of plain text. </li> <li> - <span class="highlight">version 6 and later:</span> Content is formatted text + <span class="highlight">version 6 to 7.2:</span> Content is formatted text encoded in REML markup. REML v4 is supported. </li> + <li> + <span class="highlight">version 7.3 and 7.4:</span> Content is formatted text + encoded in REML markup. REML v5 is supported. + </li> + <li> + <span class="highlight">version 7.5 and later:</span> Content is formatted text + encoded in REML markup. REML v6 is supported. + </li> </ul> </dd> @@ -279,7 +326,7 @@ <h2> <dd> <ul class="squashed"> <li> - <span class="highlight">versions 1..5:</span> Not supported. + <span class="highlight">versions 1 to 5:</span> Not supported. </li> <li> <div> @@ -308,18 +355,18 @@ <h2> </dd> <dt> - <strong>codesnip-data/routines/routine/display-name</strong> + <strong>codesnip-export/routines/routine/display-name</strong> </dt> <dd> <ul class="squashed"> <li> - <span class="highlight">versions 1..5:</span> Not supported. + <span class="highlight">versions 1 to 5:</span> Not supported. </li> <li> <span class="highlight">version 6 and later:</span> Display name of snippet. Can contain any characters and need not be unique. Present only if snippet has a display name that is different to the value of the <em>name</em> - attribute of the <em>codesnip-data/routines/routine</em> tag. + attribute of the <em>codesnip-export/routines/routine</em> tag. </li> </ul> </dd> @@ -395,18 +442,22 @@ <h2> </div> <ul class="squashed"> <li> - <span class="highlight">version 2:</span> indicates REML v1 + <span class="highlight">version 2:</span> supports REML v1. + </li> + <li> + <span class="highlight">version 3:</span> supports REML v2. + </li> + <li> + <span class="highlight">version 4:</span> supports REML v3. </li> <li> - <span class="highlight">version 3:</span> indicates REML v2 + <span class="highlight">versions 5 to 7.2:</span> supports REML v4. </li> <li> - <span class="highlight">versions 4 and 5:</span> indicates REML - v3. + <span class="highlight">version 7.3 & 7.4:</span> supports REML v5. </li> <li> - <span class="highlight">versions 6 and later:</span> indicates REML - v4. + <span class="highlight">version 7.5 & later:</span> supports REML v6. </li> </ul> </li> @@ -486,82 +537,93 @@ <h2> </div> <ul class="squashed"> <li> - <em>d2</em> – Delphi 2 compiler + <em>d2</em> – Delphi 2 compiler <span class="highlight">(all versions)</span> + </li> + <li> + <em>d3</em> – Delphi 3 compiler <span class="highlight">(all versions)</span> + </li> + <li> + <em>d4</em> – Delphi 4 compiler <span class="highlight">(all versions)</span> + </li> + <li> + <em>d5</em> – Delphi 5 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d3</em> – Delphi 3 compiler + <em>d6</em> – Delphi 6 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d4</em> – Delphi 4 compiler + <em>d7</em> – Delphi 7 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d5</em> – Delphi 5 compiler + <em>d2005</em> – Delphi 2005 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d6</em> – Delphi 6 compiler + <em>d2006</em> – Delphi 2006 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d7</em> – Delphi 7 compiler + <em>d2007</em> – Delphi 2007 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d2005</em> – Delphi 2005 compiler + <em>d2009</em> – Delphi 2009 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d2006</em> – Delphi 2006 compiler + <em>d2010</em> – Delphi 2010 compiler <span class="highlight">(v4.1 & later)</span> </li> <li> - <em>d2007</em> – Delphi 2007 compiler + <em>dXE</em> – Delphi XE compiler <span class="highlight">(v4.2 & later)</span> </li> <li> - <em>d2009</em> – Delphi 2009 compiler + <em>dXE2</em> – Delphi XE2 compiler <span class="highlight">(v4.3 & later)</span> </li> <li> - <em>d2010</em> – Delphi 2010 compiler + <em>dXE3</em> – Delphi XE3 compiler <span class="highlight">(v4.4 to v4.5 and v6.1 & later)</span> </li> <li> - <em>dXE</em> – Delphi XE compiler + <em>dXE4</em> – Delphi XE4 compiler <span class="highlight">(v4.5 only)</span> + <br /><strong>Note:</strong> CodeSnip 3 used correct <em>dXE4</em> id, but CodeSnip 4 did not (see <em>dDX4</em> below). </li> <li> - <em>dXE2</em> – Delphi XE2 compiler + <em>dDX4</em> – Delphi XE4 compiler <span class="highlight">(v6.2 & later)</span> + <br /><strong>Note:</strong> CodeSnip 4 <em>dDX4</em> in error instead of <em>dXE4</em> used by CodeSnip 3 (see above). The erroneous value was retained for backwards compatibility reasons. </li> <li> - <em>dXE3</em> – Delphi XE3 compiler + <em>dXE5</em> – Delphi XE5 compiler <span class="highlight">(v6.3 & later)</span> </li> <li> - <em>dDX4</em> – Delphi XE4 compiler. <strong>Note:</strong> - This value was named <em>dDX4</em> in error: it should have been - named <em>dXE4</em> but the erroneous value has been retained for - backwards compatibility reasons. + <em>dXE6</em> – Delphi XE6 compiler <span class="highlight">(v6.4 & later)</span> </li> <li> - <em>dXE5</em> – Delphi XE5 compiler + <em>dXE7</em> – Delphi XE7 compiler <span class="highlight">(v6.5 & later)</span> </li> <li> - <em>dXE6</em> – Delphi XE6 compiler + <em>dXE8</em> – Delphi XE8 compiler <span class="highlight">(v6.6 & later)</span> </li> <li> - <em>dXE7</em> – Delphi XE7 compiler + <em>d10s</em> – Delphi 10 Seattle compiler <span class="highlight">(v6.7 & later)</span> </li> <li> - <em>dXE8</em> – Delphi XE8 compiler + <em>d101b</em> – Delphi 10.1 Berlin compiler <span class="highlight">(v6.8 & later)</span> </li> <li> - <em>d10s</em> – Delphi 10 Seattle compiler + <em>d102t</em> – Delphi 10.2 Tokyo compiler <span class="highlight">(v7.1 & later)</span> </li> <li> - <em>d101b</em> – Delphi 10.1 Berlin compiler + <em>d103r</em> – Delphi 10.3 Rio compiler <span class="highlight">(v7.1 & later)</span> </li> <li> - <em>d102t</em> – Delphi 10.2 Tokyo compiler + <em>d104s</em> – Delphi 10.4 Sydney compiler <span class="highlight">(v7.1 & later)</span> </li> <li> - <em>d103r</em> – Delphi 10.3 Rio compiler + <em>d11a</em> – Delphi 11.x Alexandria compiler <span class="highlight">(v7.2 & later)</span> </li> <li> - <em>d104s</em> – Delphi 10.4 Sydney compiler + <em>d12y</em> – Delphi 12 Athens compiler <span class="highlight">(v7.4 & later)</span> </li> <li> - <em>fpc</em> – Free Pascal compiler + <em>d13y</em> – Delphi 13 Florence compiler <span class="highlight">(v8.1 & later)</span> + </li> + <li> + <em>fpc</em> – Free Pascal compiler <span class="highlight">(all versions)</span> </li> </ul> </dd> @@ -620,7 +682,7 @@ <h2> </div> <ul class="squashed"> <li> - <span class="highlight">versions 1..4:</span> Name must begin with an + <span class="highlight">versions 1 to 4:</span> Name must begin with an English language letter or the underscore. </li> <li> @@ -631,56 +693,74 @@ <h2> </ul> </dd> - <dt> - <strong>codesnip-export/routines/routine/xref</strong> - </dt> - <dd> - List of cross-referenced snippets. - </dd> +</section> - <dt> - <strong>codesnip-export/routines/routine/xref/pascal-name</strong> - </dt> - <dd> - <div class="half-spaced"> - Name of a snippet within cross-reference list. - </div> - <ul class="squashed"> - <li> - <span class="highlight">versions 1..4:</span> Name must begin with an - English language letter or the underscore. - </li> - <li> - <span class="highlight">version 5 and later:</span> Name can begin with - any character that is valid as the first character of a Unicode Pascal - identifier. - </li> - </ul> - </dd> -</dl> +<section id="erratum"> + +<h2> + Erratum +</h2> + +<p> + The <em>codesnip-export/routines/routine/xref</em> and <em>codesnip-export/routines/routine/xref/pascal-name</em> tags were included in versions 1 to 7 of this specification in error. XRefs were never intended to be written to export files by any version of CodeSnip, as source code comments make clear. +</p> + +<p> + These tags have been removed from this document entirely of specification version 8. +</p> + +</section> + +<section id="changelog"> <h2> - Differences Between File Versions + Change Log </h2> <p> - The differences between different export file versions is summarised below: + This section describes the changes between versions of the file format. +</p> + +<p class="pullout"> + There were small changes within versions, that probably should have been given minor version numbers - but weren't. Such minor numbers have been assigned retrospectively below, in order to better explain when in-version changes actually took place. +</p> + +<p class="pullout"> + File formats v4 and v5/v6 actually overlapped in the dates they were in use. This is because v4 was used by CodeSnip v3 and v5/v6 were used by CodeSnip 4. Those two versions of CodeSnip were maintained in parallel for a while. </p> <dl> <dt> - Version 1 + <strong>Version 1 - 15 December 2008</strong> </dt> <dd> - First version of database. + <p> + Introduced in CodeSnip v2.2 + </p> + <p> + First version of export file format. + </p> + <p> + Supported Delphi compilers from Delphi 2 to Delphi 2009 plus Free Pascal. + </p> + <p> + REML not supported. + </p> + <p> + The XML file was in UTF-8 format with no BOM and no XML encoding attribute. + </p> </dd> + <dt> - Version 2 + <strong>Version 2 - 31 December 2008</strong> </dt> <dd> - <div class="half-spaced"> - The following tags are no longer supported: - </div> + <p> + Introduced with CodeSnip v2.2.5. + </p> + <p> + Removed following tags: + </p> <ul class="squashed"> <li> <em>codesnip-export/routines/routine/comments</em> @@ -692,113 +772,279 @@ <h2> <em>codesnip-export/routines/routine/credits-url</em> </li> </ul> - <div class="half-spaced"> - The following tag was introduced: - </div> + <p> + Added following tag: + </p> <ul class="squashed"> <li> - <em>codesnip-export/routines/routine/extra</em> (uses REML v1 markup). + <em>codesnip-export/routines/routine/extra</em> </li> </ul> + <p> + The version of REML supported by the + <em>codesnip-export/routines/routine/extra</em> tag was v1. + </p> </dd> + <dt> - Version 3 + <strong>Version 3 - 29 June 2009</strong> </dt> <dd> - <div class="half-spaced"> - The following tag is no longer supported: - </div> + <p> + Introduced with CodeSnip v3.0. + </p> + <p> + The following tag was removed: + </p> <ul class="squashed"> <li> <em>codesnip-export/routines/routine/standard-format</em> </li> </ul> - <div class="half-spaced"> + <p> The following tag was introduced: - </div> + </p> <ul class="squashed"> <li> <em>codesnip-export/routines/routine/kind</em> </li> </ul> - <div class="half-spaced"> + <p> The version of REML supported by the <em>codesnip-export/routines/routine/extra</em> tag was updated to v2. - </div> + </p> </dd> + <dt> - Version 4 + <strong>Version 4 - 06 July 2009</strong> </dt> <dd> - The version of REML supported by the - <em>codesnip-export/routines/routine/extra</em> tag was updated to v3. + <p> + Introduced with CodeSnip v3.0.1. + </p> + <p> + The version of REML supported by the + <em>codesnip-export/routines/routine/extra</em> tag was updated to v3. + </p> + <dl> + <dt> + <em>Version 4.1 - 24 September 2009</em> + </dt> + <dd> + Updated with CodeSnip v3.4 to add support for Delphi 2010. + </dd> + <dt> + <em>Version 4.2 - 23 October 2010</em> + </dt> + <dd> + Updated with CodeSnip v3.8.0 to add support for Delphi XE. + </dd> + <dt> + <em>Version 4.3 - 07 September 2011</em> + </dt> + <dd> + Updated with CodeSnip v3.9.0 to add support for Delphi XE2. + </dd> + <dt> + <em>Version 4.4 - 17 September 2012</em> + </dt> + <dd> + Updated with CodeSnip v3.11.0 to add support for Delphi XE3. + </dd> + <dt> + <em>Version 4.5 - 02 May 2013</em> + </dt> + <dd> + Updated with CodeSnip v3.12.0 to add support for Delphi XE4. + </dd> + </dl> </dd> + <dt> - Version 5 + <strong>Version 5 - 31 December 2011</strong> </dt> <dd> - <div class="half-spaced"> + <p> + Introduced with CodeSnip v4.0 alpha 1. + </p> + <p> The XML file's encoding was explicitly set to "UTF-8" by setting the encoding attribute of the XML processing instruction to this value. - </div> - <div class="half-spaced"> + </p> + <p> Snippet names, wherever they occur in the XML file, can now begin with any character that is a valid first character of a Unicode Pascal identifier. Previously the first character of the attribute had to be one of 'A'..'Z', 'a'..'z' or '_'. - </div> - <div class="half-spaced"> + </p> + <p> New "class" and "unit" snippet kinds supported. - </div> + </p> + <p> + The version of REML supported by the + <em>codesnip-export/routines/routine/extra</em> tag was updated to v4. + </p> </dd> + <dt> - Version 6 + <strong>Version 6 - 11 August 2012</strong> </dt> <dd> - <div class="half-spaced"> - A snippet's description is now stored as formatted text using REML markup. - Previously the description was plain text. - </div> - <div class="half-spaced"> - The supported version of REML was updated to v4. - </div> - <div class="half-spaced"> + <p> + Introduced with CodeSnip v4.0 beta 1. + </p> + <p> + A snippet's description is now stored as formatted text using REML v4 markup. Previously the description was plain text. + </p> + <p> The following tags were introduced: - </div> + </p> <ul class="squashed"> <li> - <em>codesnip-data/routines/routine/display-name</em> + <em>codesnip-export/routines/routine/display-name</em> </li> <li> <em>codesnip-export/routines/routine/highlight-source</em> </li> </ul> + <dl> + <dt> + <em>Version 6.1 - 14 September 2012</em> + </dt> + <dd> + Updated with CodeSnip v4.0 RC 1 to add support for Delphi XE3. + </dd> + <dt> + <em>Version 6.2 - 02 May 2013</em> + </dt> + <dd> + Updated with CodeSnip v4.5.0 to add support for Delphi XE4. + </dd> + <dt> + <em>Version 6.3 - 12 September 2013</em> + </dt> + <dd> + Updated with CodeSnip v4.8.0 to add support for Delphi XE5. + </dd> + <dt> + <em>Version 6.4 - 30 April 2014</em> + </dt> + <dd> + Updated with CodeSnip v4.9.0 to add support for Delphi XE6. + </dd> + <dt> + <em>Version 6.5 - 12 September 2014</em> + </dt> + <dd> + Updated with CodeSnip v4.10.0 to add support for Delphi XE7. + </dd> + <dt> + <em>Version 6.6 - 06 May 2015</em> + </dt> + <dd> + Updated with CodeSnip v4.12.0 to add support for Delphi XE8. + </dd> + <dt> + <em>Version 6.7 - 05 September 2015</em> + </dt> + <dd> + Updated with CodeSnip v4.13.0 to add support for Delphi 10 Seattle. + </dd> + <dt> + <em>Version 6.8 - 13 July 2016</em> + </dt> + <dd> + Updated with CodeSnip v4.15.0 to add support for Delphi 10.1 Berlin. + </dd> + </dl> </dd> + <dt> - Version 7 + <strong>Version 7 - 31 May 2020</strong> </dt> <dd> - The <em>codesnip-export/user-info</em> tag and sub-tags were no longer supported. + <p> + Introduced with CodeSnip v4.16.0. + </p> + <p> + The <em>codesnip-export/user-info</em> tag and sub-tags were no longer supported. + </p> + <dl> + <dt> + <em>Version 7.1 - 31 July 2020</em> + </dt> + <dd> + Updated with CodeSnip v4.17.0 to add support for Delphi 10.2 Tokyo, Delphi 10.3 Rio and Delphi 10.4 Sydney. + </dd> + <dt> + <em>Version 7.2 - 13 September 2021</em> + </dt> + <dd> + Updated with CodeSnip v4.18.0 to add support for Delphi 11.x Alexandria. + </dd> + <dt> + <em>Version 7.3 - 16 December 2022</em> + </dt> + <dd> + Updated with CodeSnip v4.21.0 to add support for REML v5, which is backward compatible with REML v4. + </dd> + <dt> + <em>Version 7.4 - 7 November 2023</em> + </dt> + <dd> + Updated in time for CodeSnip v4.22.0 to add support for Delphi 12 Athens. + </dd> + <dt> + <em>Version 7.5 - 2 April 2014</em> + </dt> + <dd> + Added support for REML v6, which is backward compatible with REML v4. + </dd> + </dl> </dd> + + <dt> + <strong>Version 8 - 15 April 2025</strong> + </dt> + <dd> + <p> + Introduced with CodeSnip v4.24.3. + </p> + <p> + The <em>codesnip-export/routines/routine/xref</em> and <em>codesnip-export/routines/routine/xref/pascal-name</em> tags were removed from the specification. See <a href="#erratum">Erratum</a> above for details. + </p> + </dd> + <dl> + <dt> + <em>Version 8.1 - 11 September 2025</em> + </dt> + <dd> + Updated with CodeSnip v4.27.0 to add support for Delphi 13 Florence. + </dd> + </dl> </dl> -<h3> - Notes For File Readers Used For Importing -</h3> +</section> + +<section id="file-readers"> + +<h2> + Notes For File Readers +</h2> <p> Readers of v1 files must convert the contents of the - <em>codesnip-data/routines/routine/comments</em>, - <em>codesnip-data/routines/routine/credits</em> and - <em>codesnip-data/routines/routine/credits-url</em> tags into formatted text + <em>codesnip-export/routines/routine/comments</em>, + <em>codesnip-export/routines/routine/credits</em> and + <em>codesnip-export/routines/routine/credits-url</em> tags into formatted text that simulates the parsed content of a - <em>codesnip-data/routines/routine/extra</em> tag. + <em>codesnip-export/routines/routine/extra</em> tag. </p> <p> Readers of v1 and v2 files should map a - <em>codesnip-data/routines/routine/standard-format</em> value of "0" - to a <em>codesnip-data/routines/routine/kind</em> value of + <em>codesnip-export/routines/routine/standard-format</em> value of "0" + to a <em>codesnip-export/routines/routine/kind</em> value of "freeform" and a value of "1" to "routine". </p> @@ -809,7 +1055,7 @@ <h3> <ul> <li> Convert the plain text snippet description read from - <em>codesnip-data/routines/routine/description</em> into the formatted text + <em>codesnip-export/routines/routine/description</em> into the formatted text equivalent of a single paragraph containing the description. </li> <li> @@ -822,6 +1068,16 @@ <h3> Readers of v1 to v6 files must ignore the <em>codesnip-export/user-info</em> tag and sub-tags, where present. </p> +<p> + Readers of v2 files and later can parse REML as v6, since all versions of REML up to v6 are backwards compatible. +</p> + +<p> + Readers of v1 to v7 files must ignore any <em>codesnip-export/routines/routine/xref</em> tags and sub tags in the unlikely event that they are found. For an explanation see <a href="#erratum">Erratum</a> above. +</p> + +</section> + </body> </html> diff --git a/Docs/Design/FileFormats/favourites.html b/Docs/Design/FileFormats/favourites.html index e302c4837..8eeaf27d0 100644 --- a/Docs/Design/FileFormats/favourites.html +++ b/Docs/Design/FileFormats/favourites.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Favourites Files --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> diff --git a/Docs/Design/FileFormats/index.html b/Docs/Design/FileFormats/index.html index 938e01d10..eab961529 100644 --- a/Docs/Design/FileFormats/index.html +++ b/Docs/Design/FileFormats/index.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2021, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Index File --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> diff --git a/Docs/Design/FileFormats/main-db.html b/Docs/Design/FileFormats/main-db.html index 8e6f6dd77..57cb9dd7c 100644 --- a/Docs/Design/FileFormats/main-db.html +++ b/Docs/Design/FileFormats/main-db.html @@ -1,15 +1,15 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2024, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Main Database --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> @@ -199,6 +199,7 @@ <h4> Delphi102T=<Y|N|Q|W> Delphi103R=<Y|N|Q|W> Delphi104S=<Y|N|Q|W> +Delphi11A=<Y|N|Q|W> FPC=<Y|N|Q|W> Extra=<extra-info-REML> StandardFormat=<0|1> @@ -415,6 +416,15 @@ <h4> <li> <code class="key">Delphi104S</code> – Delphi 10.4 Sydney compiler * </li> + <li> + <code class="key">Delphi11A</code> – Delphi 11.x Alexandria compiler * + </li> + <li> + <code class="key">Delphi12A</code> – Delphi 12 Athens compiler * + </li> + <li> + <code class="key">Delphi13F</code> – Delphi 13 Florence compiler * + </li> <li> <code class="key">FPC</code> – Free Pascal compiler </li> @@ -921,7 +931,7 @@ <h2> <ol> <li id="footnote-1"> <p> - REML is a text markup language used to format text. REML version 4 is supported. The REML format is documented <a href="../reml.html">here</a>. + REML is a text markup language used to format text. REML version 6 is supported. The REML format is documented <a href="../reml.html">here</a>. </p> </li> <li id="footnote-2"> @@ -929,7 +939,7 @@ <h2> Here is an example of how the <code class="key">Credits</code> and <code class="key">Credits_URL</code> key work together. </p> <p> - If <code class="key">Credits</code>=<code class="value">"See [example]"</code> and <code class="key">Credits_URL</code>=<code class="value">"http://example.com"</code> and the <code class="key">Extra</code> key is empty or missing then the extra text generated will be <samp>See <a href="example.com">example 1</a></samp>. + If <code class="key">Credits</code>=<code class="value">"See [example]"</code> and <code class="key">Credits_URL</code>=<code class="value">"https://example.com"</code> and the <code class="key">Extra</code> key is empty or missing then the extra text generated will be <samp>See <a href="example.com">example 1</a></samp>. </p> </li> <li id="footnote-3"> diff --git a/Docs/Design/FileFormats/main.css b/Docs/Design/FileFormats/main.css index 396a08f6a..fcbdefa1b 100644 --- a/Docs/Design/FileFormats/main.css +++ b/Docs/Design/FileFormats/main.css @@ -1,9 +1,9 @@ /* * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2021, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: CSS used by all documentation HTML files. */ diff --git a/Docs/Design/FileFormats/saved.html b/Docs/Design/FileFormats/saved.html index ffe9ba419..7f9e6b571 100644 --- a/Docs/Design/FileFormats/saved.html +++ b/Docs/Design/FileFormats/saved.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2025, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Saved Files --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> @@ -46,20 +46,45 @@ <h2> </h2> <p> - CodeSnip saves external files in two different ways: + CodeSnip saves external files in three different ways: </p> <ol> <li> - By saving snippets to file from the <em>File | Save Snippet</em> menu. + By saving snippet information using the <em>File | Save Snippet Information</em> menu option. </li> <li> - By saving units to file from the <em>File | Save Unit</em> menu. + By saving snippets using the <em>File | Save Snippet</em> menu option. + </li> + <li> + By saving units using the <em>File | Save Unit</em> menu option. </li> </ol> <p> - In each case the following file types can be chosen by the user: + In the first case the snippet information can be saved as one of the following file types: +</p> + +<ul> + <li> + Plain text. + </li> + <li> + HTML 5 files. + </li> + <li> + XHTML files. + </li> + <li> + Rich text files. + </li> + <li> + Markdown files. + </li> +</ul> + +<p> + In the second two cases the following file types can be chosen by the user: </p> <ul> @@ -69,6 +94,9 @@ <h2> <li> Pascal source files (either .inc or .pas files). </li> + <li> + HTML 5 files. + </li> <li> XHTML files. </li> @@ -78,7 +106,7 @@ <h2> </ul> <p> - There is no specific file format for these files, except that XHTML and RTF + There is no specific file format for these files, except that HTML 5, XHTML, RTF and Markdown files conform to published specifications. </p> @@ -87,7 +115,7 @@ <h2> </h2> <p> - The encodings used depend on the file type and user choice. Different file + The available encodings depend on the file type and user choice. Different file types have different encoding choices, as follows: </p> @@ -104,10 +132,10 @@ <h2> UTF-8 </li> <li> - Unicode little endian (UTF16-LE) + UTF-16LE </li> <li> - Unicode big endian (UTF16-BE) + UTF-16BE </li> </ul> </dd> @@ -124,6 +152,16 @@ <h2> </li> </ul> </dd> + <dt> + HTML 5 files + </dt> + <dd> + <ul class="squashed"> + <li> + UTF-8 + </li> + </ul> + </dd> <dt> XHTML files </dt> @@ -137,11 +175,30 @@ <h2> <dt> Rich text files (RTF) </dt> + <dd> + <ul class="squashed"> + <li> + ASCII + </li> + </ul> + </dd> + <dt> + Markdown + </dt> <dd> <ul class="squashed"> <li> ANSI (system default code page) </li> + <li> + UTF-8 + </li> + <li> + UTF-16LE + </li> + <li> + UTF-16BE + </li> </ul> </dd> </dl> diff --git a/Docs/Design/FileFormats/selection.html b/Docs/Design/FileFormats/selection.html index 687f8d739..6d597fce3 100644 --- a/Docs/Design/FileFormats/selection.html +++ b/Docs/Design/FileFormats/selection.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2021, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Selection Files --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> diff --git a/Docs/Design/FileFormats/test-unit.html b/Docs/Design/FileFormats/test-unit.html index 0a9e4a09b..4d0722607 100644 --- a/Docs/Design/FileFormats/test-unit.html +++ b/Docs/Design/FileFormats/test-unit.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2021, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: Test Units --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> diff --git a/Docs/Design/FileFormats/user-db.html b/Docs/Design/FileFormats/user-db.html index 766ee527c..fbcfa7a3f 100644 --- a/Docs/Design/FileFormats/user-db.html +++ b/Docs/Design/FileFormats/user-db.html @@ -1,15 +1,15 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2024, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip File Format Documentation: User Database --> -<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> +<html xmlns="https://www.w3.org/1999/xhtml" lang="en" xml:lang="en"> <head> @@ -41,6 +41,42 @@ <h1> User Database Files </h1> +<section id="contents"> + +<h2> + Contents +</h2> + +<ul> + <li> + <a href="#intro">Introduction</a> + </li> + <li> + <a href="#encoding">Encoding</a> + </li> + <li> + <a href="#format">File Format</a> + <ul> + <li> + <a href="#xml-file">XML File</a> + </li> + <li> + <a href="#source-files">Source Files</a> + </li> + </ul> + </li> + <li> + <a href="#changes">Change Log</a> + </li> + <li> + <a href="#file-readers">Notes for File Readers</a> + </li> +</ul> + +</section> + +<section id="intro"> + <h2> Introduction </h2> @@ -62,10 +98,13 @@ <h2> </p> <p> - There have been several different versions of the XML file format. Each of - these is explained below. + There have been several different versions of the XML file format. The differences between versions are explained below. Details of all the changes between versions are listed in the <a href="#changes">Change Log</a> at the end of this document </p> +</section> + +<section id="encoding"> + <h2> Encoding </h2> @@ -78,9 +117,7 @@ <h2> </p> <p> - Prior to CodeSnip v4 source code data files were encoded using the system - default ANSI code page. The XML file was in UTF-8, but its XML processing - instruction had no "encoding" atrribute. + Prior to CodeSnip v4 (and database v5) source code data files were encoded using ANSI code page 1252. The XML file was in UTF-8, but its XML processing instruction had no "encoding" atrribute. </p> <p> @@ -88,11 +125,15 @@ <h2> inherit a copy of a user database in an earlier format. </p> +</section> + +<section id="format"> + <h2> File Format </h2> -<h3> +<h3 id="xml-file"> XML File </h3> @@ -158,7 +199,7 @@ <h3> <em>version</em> </dt> <dd> - Identifies version of file. Determines which tags are valid and rules + Identifies major version of file. Determines which tags are valid and rules concerning content. Valid versions are 1..6. </dd> </dl> @@ -280,8 +321,16 @@ <h3> of plain text. </li> <li> - <span class="highlight">version 6:</span> Content is formatted text - encoded in REML markup. REML v4 is supported. + <span class="highlight">version 6.0 to 6.10:</span> Content is formatted text + encoded in <a href="../reml.html">REML</a> markup. <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v4.html">REML v4</a> is supported. + </li> + <li> + <span class="highlight">version 6.11 & 6.12:</span> Content is formatted text + encoded in <a href="../reml.html">REML</a> markup. <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v5.html">REML v5</a> is supported. + </li> + <li> + <span class="highlight">version 6.13 & later:</span> Content is formatted text + encoded in <a href="../reml.html">REML</a> markup. <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v6.html">REML v6</a> is supported. </li> </ul> </dd> @@ -294,7 +343,7 @@ <h3> </dd> <dt> - <strong>codesnip-export/routines/routine/highlight-source</strong> + <strong>codesnip-data/routines/routine/highlight-source</strong> </dt> <dd> <ul class="squashed"> @@ -411,20 +460,26 @@ <h3> <div class="unspaced"> <span class="highlight">version 2 and later:</span> Additional information about a snippet. Content is formatted text encoded in - REML markup. + <a href="../reml.html">REML</a> markup. </div> <ul class="squashed"> <li> - <span class="highlight">version 2:</span> indicates REML v1 + <span class="highlight">version 2:</span> supports <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v1.html">REML v1</a>. + </li> + <li> + <span class="highlight">version 3:</span> supports <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v2.html">REML v2</a>. </li> <li> - <span class="highlight">version 3:</span> indicates REML v2 + <span class="highlight">version 4:</span> supports <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v3.html">REML v3</a>. </li> <li> - <span class="highlight">versions 4..5:</span> indicates REML v3. + <span class="highlight">versions 5 & 6.10:</span> supports <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v4.html">REML v4</a>. </li> <li> - <span class="highlight">version 6:</span> indicates REML v4. + <span class="highlight">version 6.11 & 6.12:</span> supports <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v5.html">REML v5</a>. + </li> + <li> + <span class="highlight">version 6.13 & later:</span> supports <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v6.html">REML v6</a>. </li> </ul> </li> @@ -504,82 +559,93 @@ <h3> </div> <ul class="squashed"> <li> - <em>d2</em> – Delphi 2 compiler + <em>d2</em> – Delphi 2 compiler <span class="highlight">(all versions)</span> + </li> + <li> + <em>d3</em> – Delphi 3 compiler <span class="highlight">(all versions)</span> + </li> + <li> + <em>d4</em> – Delphi 4 compiler <span class="highlight">(all versions)</span> + </li> + <li> + <em>d5</em> – Delphi 5 compiler <span class="highlight">(all versions)</span> + </li> + <li> + <em>d6</em> – Delphi 6 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d3</em> – Delphi 3 compiler + <em>d7</em> – Delphi 7 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d4</em> – Delphi 4 compiler + <em>d2005</em> – Delphi 2005 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d5</em> – Delphi 5 compiler + <em>d2006</em> – Delphi 2006 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d6</em> – Delphi 6 compiler + <em>d2007</em> – Delphi 2007 compiler <span class="highlight">(all versions)</span> </li> <li> - <em>d7</em> – Delphi 7 compiler + <em>d2009</em> – Delphi 2009 compiler <span class="highlight">(v1.1 & later)</span> </li> <li> - <em>d2005</em> – Delphi 2005 compiler + <em>d2010</em> – Delphi 2010 compiler <span class="highlight">(v4.1 & later)</span> </li> <li> - <em>d2006</em> – Delphi 2006 compiler + <em>dXE</em> – Delphi XE compiler <span class="highlight">(v4.2 & later)</span> </li> <li> - <em>d2007</em> – Delphi 2007 compiler + <em>dXE2</em> – Delphi XE2 compiler <span class="highlight">(v4.3 & later)</span> </li> <li> - <em>d2009</em> – Delphi 2009 compiler + <em>dXE3</em> – Delphi XE3 compiler <span class="highlight">(v4.4..v4.5 and v6.1 & later)</span> </li> <li> - <em>d2010</em> – Delphi 2010 compiler + <em>dXE4</em> – Delphi XE4 compiler <span class="highlight">(v4.5 only)</span> + <br /><strong>Note:</strong> CodeSnip 3 used correct <em>dXE4</em> id, but CodeSnip 4 did not (see <em>dDX4</em> below). </li> <li> - <em>dXE</em> – Delphi XE compiler + <em>dDX4</em> – Delphi XE4 compiler <span class="highlight">(v6.2 & later)</span> + <br /><strong>Note:</strong> CodeSnip 4 <em>dDX4</em> in error instead of <em>dXE4</em> used by CodeSnip 3 (see above). The erroneous value was retained for backwards compatibility reasons. </li> <li> - <em>dXE2</em> – Delphi XE2 compiler + <em>dXE5</em> – Delphi XE5 compiler <span class="highlight">(v6.3 & later)</span> </li> <li> - <em>dXE3</em> – Delphi XE3 compiler + <em>dXE6</em> – Delphi XE6 compiler <span class="highlight">(v6.4 & later)</span> </li> <li> - <em>dDX4</em> – Delphi XE4 compiler. <strong>Note:</strong> - This value was named <em>dDX4</em> in error: it should have been - named <em>dXE4</em> but the erroneous value has been retained for - backwards compatibility reasons. + <em>dXE7</em> – Delphi XE7 compiler <span class="highlight">(v6.5 & later)</span> </li> <li> - <em>dXE5</em> – Delphi XE5 compiler + <em>dXE8</em> – Delphi XE8 compiler <span class="highlight">(v6.6 & later)</span> </li> <li> - <em>dXE6</em> – Delphi XE6 compiler + <em>d10s</em> – Delphi 10 Seattle compiler <span class="highlight">(v6.7 & later)</span> </li> <li> - <em>dXE7</em> – Delphi XE7 compiler + <em>d101b</em> – Delphi 10.1 Berlin compiler <span class="highlight">(v6.8 & later)</span> </li> <li> - <em>dXE8</em> – Delphi XE8 compiler + <em>d102t</em> – Delphi 10.2 Tokyo compiler <span class="highlight">(v6.9 & later)</span> </li> <li> - <em>d10s</em> – Delphi 10 Seattle compiler + <em>d103r</em> – Delphi 10.3 Rio compiler <span class="highlight">(v6.9 & later)</span> </li> <li> - <em>d101b</em> – Delphi 10.1 Berlin compiler + <em>d104s</em> – Delphi 10.4 Sydney compiler <span class="highlight">(v6.9 & later)</span> </li> <li> - <em>d102t</em> – Delphi 10.2 Tokyo compiler + <em>d11a</em> – Delphi 11.x Alexandria compiler <span class="highlight">(v6.10 & later)</span> </li> <li> - <em>d103r</em> – Delphi 10.3 Rio compiler + <em>d12y</em> – Delphi 12 Athens compiler <span class="highlight">(v6.12 & later)</span> </li> <li> - <em>d104s</em> – Delphi 10.4 Sydney compiler + <em>d13f</em> – Delphi 13 Florence compiler <span class="highlight">(v6.14 & later)</span> </li> <li> - <em>fpc</em> – Free Pascal compiler + <em>fpc</em> – Free Pascal compiler <span class="highlight">(all versions)</span> </li> </ul> </dd> @@ -677,7 +743,7 @@ <h3> </dd> </dl> -<h3> +<h3 id="source-files"> Source Code Files </h3> @@ -693,29 +759,63 @@ <h3> XML file. </p> +</section> + +<section id="changes"> + <h2> - Differences Between File Versions + Change Log </h2> <p> - The differences between different user database file versions is summarised - below: + This section describes the changes between versions of the file format. +</p> + +<p class="pullout"> + There were small changes within versions, that probably should have been given minor version numbers - but weren't. Such minor numbers have been assigned retrospectively below in order to better explain when in-version changes actually took place. +</p> + +<p class="pullout"> + File formats v4 and v5/v6 actually overlapped in the dates they were in use. This is because v4 was used by CodeSnip v3 and v5/v6 were used by CodeSnip 4. Those two versions of CodeSnip were maintained in parallel for a while. </p> <dl> <dt> - Version 1 + <strong>Version 1 - 15 September 2008</strong> </dt> <dd> - First version of database. + <p> + Introduced with CodeSnip v2.0. + </p> + <p> + Supported Delphi compilers from Delphi 2 to Delphi 2007 plus Free Pascal. + </p> + <p> + <a href="../reml.html">REML</a> not supported. + </p> + <p> + Data files were ANSI text using code page 1252. The XML file was in UTF-8 format with no BOM and no XML encoding attribute. + </p> + <dl> + <dt> + <em>Version 1.1 - 11 October 2008</em> + </dt> + <dd> + Updated with CodeSnip v2.1 to add support for Delphi 2009. + </dd> + </dl> </dd> + <dt> - Version 2 + <strong>Version 2 - 31 December 2008</strong> </dt> <dd> - <div class="half-spaced"> - The following tags are no longer supported: - </div> + <p> + Introduced with CodeSnip v2.2.5. + </p> + <p> + Removed following tags: + </p> <ul class="squashed"> <li> <em>codesnip-data/routines/routine/comments</em> @@ -727,105 +827,262 @@ <h2> <em>codesnip-data/routines/routine/credits-url</em> </li> </ul> - <div class="half-spaced"> - The following tag was introduced: - </div> + <p> + Added following tag: + </p> <ul class="squashed"> <li> - <em>codesnip-data/routines/routine/extra</em> (uses REML v1 markup). + <em>codesnip-data/routines/routine/extra</em> </li> </ul> + <p> + The version of <a href="../reml.html">REML</a> supported by the + <em>codesnip-data/routines/routine/extra</em> tag was <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v1.html">v1</a>. + </p> </dd> + <dt> - Version 3 + <strong>Version 3 - 29 June 2009</strong> </dt> <dd> - <div class="half-spaced"> + <p> + Introduced with CodeSnip v3.0. + </p> + <p> The following tag is no longer supported: - </div> + </p> <ul class="squashed"> <li> <em>codesnip-data/routines/routine/standard-format</em> </li> </ul> - <div class="half-spaced"> + <p> The following tag was introduced: - </div> + </p> <ul class="squashed"> <li> <em>codesnip-data/routines/routine/kind</em> </li> </ul> - <div class="half-spaced"> - The version of REML supported by the - <em>codesnip-data/routines/routine/extra</em> tag was updated to v2. - </div> + <p> + The version of <a href="../reml.html">REML</a> supported by the + <em>codesnip-data/routines/routine/extra</em> tag was updated to <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v2.html">v2</a>. + </p> </dd> + <dt> - Version 4 + <strong>Version 4 - 06 July 2009</strong> </dt> <dd> - The version of REML supported by the - <em>codesnip-data/routines/routine/extra</em> tag was updated to v3. + <p> + Introduced with CodeSnip v3.0.1. + </p> + <p> + The version of <a href="../reml.html">REML</a> supported by the + <em>codesnip-data/routines/routine/extra</em> tag was updated to <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v3.html">v3</a>. + </p> + <dl> + <dt> + <em>Version 4.1 - 24 September 2009</em> + </dt> + <dd> + Updated with CodeSnip v3.4 to add support for Delphi 2010. + </dd> + <dt> + <em>Version 4.2 - 23 October 2010</em> + </dt> + <dd> + Updated with CodeSnip v3.8.0 to add support for Delphi XE. + </dd> + <dt> + <em>Version 4.3 - 07 September 2011</em> + </dt> + <dd> + Updated with CodeSnip v3.9.0 to add support for Delphi XE2. + </dd> + <dt> + <em>Version 4.4 - 17 September 2012</em> + </dt> + <dd> + Updated with CodeSnip v3.11.0 to add support for Delphi XE3. + </dd> + <dt> + <em>Version 4.5 - 02 May 2013</em> + </dt> + <dd> + Updated with CodeSnip v3.12.0 to add support for Delphi XE4. + </dd> + </dl> </dd> + <dt> - Version 5 + <strong>Version 5 - 21 April 2012</strong> </dt> <dd> - <div class="half-spaced"> + <p> + Introduced with CodeSnip v4.0 alpha 2. + </p> + <p> The XML file's encoding was explicitly set to "UTF-8" by setting the encoding attribute of the XML processing instruction to this value. - </div> - <div class="half-spaced"> + </p> + <p> Snippet names, wherever they occur in the XML file, can now begin with any character that is a valid first character of a Unicode Pascal identifier. Previously the first character of the attribute had to be one of 'A'..'Z', 'a'..'z' or '_'. - </div> - <div class="half-spaced"> + </p> + <p> Data files changed to use UTF-8 encoding with no BOM instead of the system default encoding. - </div> - <div class="half-spaced"> + </p> + <p> New "class" and "unit" snippet kinds supported. - </div> + </p> + <p> + The version of <a href="../reml.html">REML</a> supported by the + <em>codesnip-data/routines/routine/extra</em> tag was updated to <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v4.html">v4</a>. + </p> </dd> + <dt> - Version 6 + <strong>Version 6 - 11 August 2012</strong> </dt> <dd> - <div class="half-spaced"> - A snippet's description is now stored as formatted text using REML markup. - Previously the description was plain text. - </div> - <div class="half-spaced"> - The supported version of REML was updated to v4. - </div> - <div class="half-spaced"> + <p> + Introduced with CodeSnip v4.0 beta 1. + </p> + <p> + A snippet's description is now stored as formatted text using <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v4.html">REML v4</a> markup. Previously the description was plain text. + </p> + <p> The following tags were introduced: - </div> + </p> <ul class="squashed"> <li> <em>codesnip-data/routines/routine/display-name</em> </li> <li> - <em>codesnip-export/routines/routine/highlight-source</em> + <em>codesnip-data/routines/routine/highlight-source</em> </li> </ul> + <dl> + <dt> + <em>Version 6.1 - 14 September 2012</em> + </dt> + <dd> + Updated with CodeSnip v4.0 RC 1 to add support for Delphi XE3. + </dd> + <dt> + <em>Version 6.2 - 02 May 2013</em> + </dt> + <dd> + Updated with CodeSnip v4.5.0 to add support for Delphi XE4. + </dd> + <dt> + <em>Version 6.3 - 12 September 2013</em> + </dt> + <dd> + Updated with CodeSnip v4.8.0 to add support for Delphi XE5. + </dd> + <dt> + <em>Version 6.4 - 30 April 2014</em> + </dt> + <dd> + Updated with CodeSnip v4.9.0 to add support for Delphi XE6. + </dd> + <dt> + <em>Version 6.5 - 12 September 2014</em> + </dt> + <dd> + Updated with CodeSnip v4.10.0 to add support for Delphi XE7. + </dd> + <dt> + <em>Version 6.6 - 06 May 2015</em> + </dt> + <dd> + Updated with CodeSnip v4.12.0 to add support for Delphi XE8. + </dd> + <dt> + <em>Version 6.7 - 05 September 2015</em> + </dt> + <dd> + Updated with CodeSnip v4.13.0 to add support for Delphi 10 Seattle. + </dd> + <dt> + <em>Version 6.8 - 13 July 2016</em> + </dt> + <dd> + Updated with CodeSnip v4.15.0 to add support for Delphi 10.1 Berlin. + </dd> + <dt> + <em>Version 6.9 - 31 July 2020</em> + </dt> + <dd> + Updated with CodeSnip v4.17.0 to add support for Delphi 10.2 Tokyo, Delphi 10.3 Rio and Delphi 10.4 Sydney. + </dd> + <dt> + <em>Version 6.10 - 13 September 2021</em> + </dt> + <dd> + Updated with CodeSnip v4.18.0 to add support for Delphi 11.x Alexandria. + </dd> + <dt> + <em>Version 6.11 - 16 December 2022</em> + </dt> + <dd> + Updated with CodeSnip v4.21.0 to add support for <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v5.html">REML v5</a>, which is backwards compatible with <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v4.html">REML v4</a>. + </dd> + <dt> + <em>Version 6.12 - 7 November 2023</em> + </dt> + <dd> + Updated in time for CodeSnip v4.22.0 to add support for Delphi 12 Athens. + </dd> + <dt> + <em>Version 6.13 - 2 April 2024</em> + </dt> + <dd> + Updated with CodeSnip v4.23.0 to add support for <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v6.html">REML v6</a>, which is backwards compatible with <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v4.html">REML v4</a>. + </dd> + <dt> + Version 6.14 - 12 September 2025 + </dt> + <dd> + Updated in time for CodeSnip v4.27.0 to add support for Delphi 13 Florence. + </dd> + </dl> </dd> </dl> -<h3> +</section> + +<section id="file-readers"> + +<h2> Notes for File Readers +</h2> + +<p> + To ensure backwards compatibility with all user database versions file reader software that works with the latest version of CodeSnip needs to be able to interpret older formats as follows. +</p> + +<h3> + Handling redundant XML tags </h3> <p> - Readers of version 1 files must convert the contents of the - <em>codesnip-data/routines/routine/comments</em>, - <em>codesnip-data/routines/routine/credits</em> and - <em>codesnip-data/routines/routine/credits-url</em> tags into valid REML code - that simulates the parsed content of the - <em>codesnip-data/routines/routine/extra</em> tag. + Readers of version 1 files must convert the contents of the the following tags: +</p> + +<ul> + <li><em>codesnip-data/routines/routine/comments</em></li> + <li><em>codesnip-data/routines/routine/credits</em></li> + <li><em>codesnip-data/routines/routine/credits-url</em></li> +</ul> + +<p> + into valid <a href="../reml.html">REML</a> code that simulates the parsed content of the <em>codesnip-data/routines/routine/extra</em> tag. </p> <p> @@ -838,18 +1095,37 @@ <h3> <p> Readers of v1 to v5 files must: </p> -<ol> + +<ul> <li> Convert the plain text snippet description read from - <em>codesnip-data/routines/routine/description</em> into the REML + <em>codesnip-data/routines/routine/description</em> into the <a href="../reml.html">REML</a> equivalent of a single paragraph containing the description. </li> <li> - Proceed as if a <em>codesnip-export/routines/routine/highlight-source</em> + Proceed as if a <em>codesnip-data/routines/routine/highlight-source</em> tag with value "1" had been specified. </li> </ul> +<p> + Readers of v2 and later files may parse <a href="../reml.html">REML</a> from any file version as if it were <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v6.html">REML v6</a>, since all versions of REML up to v6 are compatible. +</p> + +<h3> + Handling Text File Encodings +</h3> + +<p> + Readers of v1 to v4 files should interpret all source code .dat files as encoded in ANSI code page 1252 - the files were created using the default code page in the UK, which is 1252. The XML file should be assumed to be in UTF-8 format, regardless of the absence of an encoding attribute. +</p> + +<p> + v5 and later files will always be encoded in UTF-8. +</p> + +</section> + </body> </html> diff --git a/Docs/Design/reml.html b/Docs/Design/reml.html index 7fc043b6c..fb8b0ce15 100644 --- a/Docs/Design/reml.html +++ b/Docs/Design/reml.html @@ -1,7 +1,7 @@ <!DOCTYPE HTML> <!-- - * This file copyright (C) 2020, Peter Johnson (gravatar.com/delphidabbler) and + * This file copyright (C) 2020-2024, Peter Johnson (gravatar.com/delphidabbler) and * is licensed under the MIT License: https://opensource.org/licenses/MIT * * DelphiDabbler Code Snippets Database Documentation: REML markup language @@ -19,7 +19,7 @@ <script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script> <![endif]--> <meta name="author" content="Peter Johnson - https://en.gravatar.com/delphidabbler"> -<meta name="description" content="DelphiDabbler Code Snippets collection documentation - REML markup language"> +<meta name="description" content="DelphiDabbler Code Snippets documentation - REML markup language"> <style> body { font-family: "Segoe UI", Tahoma, Geneva, Helvetica, Arial, sans-serif; @@ -44,29 +44,6 @@ text-align: center; margin: 0.5em; } - -header nav { - display: block; - margin: 1em; - font-weight: normal; - font-size: 90%; -} -header nav ul { - list-style: none; - margin: 0; - text-align: center; -} -header nav li { - display: inline; -} -header nav a { - text-decoration: none; - white-space: nowrap; - padding: 0.5em; -} -header nav a:hover { - background-color: #eeeeee; -} h1 { font-weight: bold; font-size: 200%; @@ -80,47 +57,11 @@ padding: 0; margin: 0.75em 0; } -aside { - display: block; - xfont-size: 100%; - font-style: italic; - padding: 0.25em 0.5em; - margin: 0.75em 2em; - border-left: 2px solid silver; - border-right: 1px solid silver; - border-top: 1px solid silver; - border-bottom: 2px solid silver; - border-radius: 6px; - background-color: #f5f5f5; -} -aside code.value { - background-color: #ddd; -} p { font-size: 100%; padding: 0; margin: 0.75em 0; } -pre, code { - font-family: "Lucida Console", "Courier New", Courier, monospace; - font-size: 90%; -} -pre.sample { - margin: 0.75em 2em; - background-color: #f5f5f5; - padding: 0.5em; -} -code.key, code.value { - background-color: #f5f5f5; - padding: 1px 4px; -} -code.key { - font-weight: bold; - font-style: none; -} -code.value { - font-style: normal; -} ul { font-size: 100%; padding: 0; @@ -142,21 +83,6 @@ ul.unspaced li { margin: 0; } -.very-strong { - xtext-transform: uppercase; - font-variant: small-caps; - font-weight: bold; -} -dt { - margin: 0; - padding: 0; - font-weight: inherited; -} -dd { - margin: 0 0 0 2em; - padding: 0; - font-weight: normal; -} a { color: rgb(46, 46, 192); } @@ -190,199 +116,56 @@ </p> </div> - <nav id="contents"> - <ul> - <li> - <a href="#intro">Introduction</a> - </li> - <li> - <a href="#tags">Tags</a> - </li> - <li> - <a href="#entities">Character Entities</a> - </li> - </ul> - </nav> - </header> +<main> + <section id="intro"> <h1> - Introduction + About REML </h1> <p> - REML is a little markup language that can be used to style text. It is used in Code Snippets collection meta data for certain properties of a snippet. + REML is a little markup language that can be used to style text. It is a SGML language similar to HTML, albeit much smaller. A small number of tags and character entities are supported. </p> + <p> - The REML language is a SGML language similar to a greatly simplified XHTML. The are a small number of tags and character entities that can be used. + See the <a href="https://htmlpreview.github.io/?https://raw.githubusercontent.com/delphidabbler/reml/main/docs/reml-v6.html">REML v6 language definition</a> for full details. </p> - <aside> - <strong>Note:</strong> The language described here is REML v4. Earlier versions are obsolete. - </aside> </section> -<section id="tags"> +<section id="reml-in-codesnip"> <h1> - Tags + REML in CodeSnip </h1> <p> - There are two types of tags: block level and in-line. - </p> - - <p> - If an unrecognised tag is encountered an REML code the interpreter <em>should</em> report an error. However, providing start and end tags are matched, the interpreter <em>may</em> choose to simply ignore the tags. + Code snippets include REML to format snippets' description and extra fields. CodeSnip interprets and renders the REML when displaying snippets in its UI and when printing them. </p> - <h2> - Block Level Tags - </h2> - - <p> - Block level tags separate the enclosed text into paragraphs of some description. The supported tags are: - </p> - <ul class="half-spaced"> - <li> - <code class="value"><p>...</p></code> – Renders the enclosed markup as a simple paragraph. - </li> - <li> - <code class="value"><heading>...</heading></code> – Renders the enclosed markup as a heading. - </li> - </ul> <p> - The following rules apply to the use of block level tags: + CodeSnip currently supports REML v6. Earlier versions of CodeSnip supported different versions of REML: </p> - <ul class="unspaced"> - <li> - The tags <span class="very-strong">must not</span> be nested. - </li> - <li> - The tags <span class="very-strong">must</span> be matched, e.g. <code class="value"><p></code> must have a matching <code class="value"></p></code>. - </li> - <li> - All text <em>should</em> be embedded within block level tags, e.g. <code class="value"><heading>heading</heading><p>text</p></code> or simply <code class="value"><p>text</p></code>. - </li> - <li> - White space between blocks <span class="very-strong">must</span> be ignored. - </li> + + <ul> + <li>REML v1 was first supported by CodeSnip v2.2.5</li> + <li>REML v2 was first supported by CodeSnip v3.0</li> + <li>REML v3 was first supported by CodeSnip v3.0.1</li> + <li>REML v4 was first supported by CodeSnip v4.0 alpha 1 (preview)</li> + <li>REML v5 was first supported by CodeSnip v4.21.0</li> + <li>REML v6 was first supported by CodeSnip v4.23.0</li> </ul> - <p> - Here is a valid example: - </p> - <pre class="sample"><p>Hello World</p> -<heading>Hello</heading> -<p>Hello World</p></pre> - <p> - Strictly speaking, the following example is invalid code – all occurrences of <code class="value">wrong</code> are in error because they are not contained within block tags. - </p> - <pre class="sample">wrong <heading>blah</heading> wrong <p>blah</p> wrong</pre> - <p> - However interpreting code <em>may</em> interpret this permissively. If this is done the text outside blocks <span class="very-strong">must</span> be interpreted as if it was enclosed in <code class="value"><p></code> and <code class="value"></p></code> tags. Therefore the above code would be interpreted as: - </p> - <pre class="sample"><p>wrong </p><heading>blah</heading><p>wrong </p><p>blah</p><p>wrong</p></pre> - <aside> - <strong>Note:</strong> Code Snippets Database collections <em>may</em> contain such non-conforming REML. Therefore interpreters of REML that need to accept such collections <span class="very-strong">must</span> be able to handle text without enclosing block tags. - </aside> - <h2> - Inline Tags - </h2> - - <p> - In-line tags format the text enclosed between the start and end tags. - </p> - <p> - Here are the available in-line tags: - </p> - <ul class="half-spaced"> - <li> - <code class="value"><strong>...</strong></code> – Renders the enclosed markup with strong emphasis. - </li> - <li> - <code class="value"><em>...</em></code> – Emphasises the enclosed markup. - </li> - <li> - <code class="value"><var>...</var></code> – Used to indicate the enclosed markup is a variable. - </li> - <li> - <code class="value"><warning>...</warning></code> – Used for warning text. - </li> - <li> - <code class="value"><mono>...</mono></code> – Renders markup in a mono-spaced font. - </li> - <li> - <code class="value"><a href="url">...</a></code> – Creates a hyper-link. The <code class="value">href</code> attribute <span class="very-strong">must</span> specify the required URL, which <span class="very-strong">must</span> use one of the <code class="value">http</code>, <code class="value">https</code> or <code class="value">file</code> protocols; others are not permitted. If you use the <code class="value">file</code> protocol it <span class="very-strong">must</span> reference a valid local or network file. - </li> - </ul> <p> - The following rules apply to the use of in-line tags: + All CodeSnip versions are backward compatible with earlier versions of REML. </p> - <ul class="unspaced"> - <li> - In-line tags <span class="very-strong">must</span> be embedded inside a block level tag. E.g. <code class="value"><p>one<strong>two</strong>three</p></code>. - </li> - <li> - Tags <span class="very-strong">must</span> match. E.g. <code class="value"><em></code> must be matched with <code class="value"></em></code>. - </li> - <li> - Tags may be nested, providing the tags match. E.g. <code class="value"><em>blah <var>blah</var></em></code> is valid but <code class="value"><em>blah <var>blah</em></var></code> is not. - </li> - </ul> - <p> - Examples: - </p> - <pre class="sample"><p>Make stuff <strong>stand out</strong>.</p> -<p><em>Emphasised <warning>warning!</warning></em></p> -<p>Refer to a function <var>parameter</var>.</p> -<p>Use the: <mono>Windows</mono> unit.</p> -<p>See this <a href="http://example.com">example</a>.</p></pre> </section> -<section id="entities"> - - <h1> - Character Entities - </h1> - - <p> - A few symbolic character entities are supported in REML. Here is the complete list: - </p> - <ul class="half-spaced"> - <li> - <code class="value">&lt;</code> for <code class="value"><</code> - </li> - <li> - <code class="value">&gt;</code> for <code class="value">></code> - </li> - <li> - <code class="value">&quot;</code> for <code class="value">"</code> - </li> - <li> - <code class="value">&amp;</code> for <code class="value">&</code> - </li> - <li> - <code class="value">&copy;</code> for <code class="value">©</code> - </li> - </ul> - - <aside> - <strong>Note:</strong> the '<' and '&' characters are special within the markup and cannot be used literally, even when you are just entering plain text. You <span class="very-strong">must</span> use the <code class="value">&lt;</code> character entity in place of <code class="value"><</code> and <code class="value">&amp;</code> instead of <code class="value">&</code>. For example to write <code class="value">x<y</code> in REML use <code class="value">x&lt;y</code> and to write <code class="value">you & me</code> use <code class="value">you &amp; me</code>. - </aside> - - <p> - To express other special symbols for which there is no symbolic character entity, numeric character entities can be used. For example to display the '¶' character (Unicode <em>pilcrow sign</em>) use <code class="value">&#182;</code>. - </p> - - <aside> - <strong>Note:</strong> Numeric entities should be used with caution because the characters they represent may vary across different text encodings, whereas symbolic entities are safe across encodings. - </aside> - -</section> +</main> </body> diff --git a/Docs/LICENSE b/Docs/LICENSE deleted file mode 100644 index 51a6b6038..000000000 --- a/Docs/LICENSE +++ /dev/null @@ -1,9 +0,0 @@ -All the files in the Docs directory, and all its sub-directories are governed by -the following license. - -This Source Code Form is subject to the terms of the Mozilla Public -License, v. 2.0. If a copy of the MPL was not distributed with this -file, You can obtain one at http://mozilla.org/MPL/2.0/. - -All files are Copyright (C) 2012-2020, Peter Johnson -(gravatar.com/delphidabbler). diff --git a/Docs/License.html b/Docs/License.html index 52878d3b6..c47a44323 100644 --- a/Docs/License.html +++ b/Docs/License.html @@ -1,20 +1,20 @@ <!DOCTYPE HTML> <!-- - * This Source Code Form is subject to the terms of the Mozilla Public License, - * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ - * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2025, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip license. + * + * This file MUST NOT be modified for use in derived programs. + * Display this file in a web browser and read its content for further + * information. --> <html lang="en"> <head> -<meta charset="UTF-8" /> +<meta charset="UTF-8"> <title> CodeSnip License @@ -221,11 +221,17 @@ <h1> Overview </h1> + <p> + This license applies to the standard and portable editions <em>CodeSnip</em> in executable form and to <em>CodeSnip</em>'s source code. + </p> + <p> + An unaltered copy of this license <strong>must</strong> be distributed with any executable or source code form of <em>CodeSnip</em>. + </p> <h2> Executable Program </h2> <p> - DelphiDabbler <em>CodeSnip</em> is copyright © 2005-2020 by <a + DelphiDabbler <em>CodeSnip</em> is copyright © 2005-2025 by <a href="https://gravatar.com/delphidabbler" >Peter D Johnson</a>. </p> @@ -237,167 +243,206 @@ <h2> <em>CodeSnip</em> as you wish. </p> <p> - You may also modify <em>CodeSnip</em> as you wish and you may distribute - copies of your modified version under the terms of the license. The only exception is that you may not use the program's branding - (including the names "DelphiDabbler" and "CodeSnip", the program's icon and the splash screen), in any modification you distribute, - unless you have the explicit permission of the copyright holder. + You may also modify <em>CodeSnip</em> and you may distribute copies of your modified version under the terms of the license, with the exception that you may not use the program's branding (including the names "DelphiDabbler" and "CodeSnip", the program's icon and the splash screen), in any modification you distribute, unless you have the explicit permission of the copyright holder. </p> <h2> Source Code </h2> <p> - All of <em>CodeSnip</em>'s original source code, including third party code, - is available from the <a - href="https://github.com/delphidabbler/codesnip" - ><em>CodeSnip</em> GitHub repository</a>. + For the purposes of this license, the term "source code" refers to all files that are part of the <a href="https://github.com/delphidabbler/codesnip"><em>delphidabbler/codesnip</em></a> repository on GitHub. This includes all program code, documentation and image files. </p> <p> - Details of the license applying to a source code file will usually be - included in a comment within the file itself. If this is not the case any - file named <kbd>LICENSE</kbd> in the same directory, or a parent directory, - should contain the required information. + Unless explicitly mentioned in the <em>Exceptions</em> sub-section below, all source files are licensed under the <a href="#mpl-2.0">Mozilla Public License 2.0</a> (MPL 2.0). </p> + <h3> + Exceptions + </h3> <p> - Most of the source code is available under the <a href="#mpl-2.0">Mozilla - Public License 2.0</a> (MPL 2.0). Other relevant source code licenses are - listed below. + The following licenses apply to the specified files: </p> <ul> <li> <div class="license-name"> - <a href="#md5">MD5 License</a> + <a href="#tlistviewex">Vadim Crit's TListViewEx License</a> + </div> + <div class="applies-to"> + <kbd>Src/3rdParty/LVEx.pas</kbd>. </div> <div class="applies-to"> - Applies to <kbd>Src/3rdParty/PJMD5.pas</kbd>, in addition to the <a - href="#mpl-2.0" - >Mozilla Public License 2.0</a>. + <kbd>Src/3rdParty/LVEx.res</kbd>. </div> </li> <li> <div class="license-name"> - <a href="#tgifimage">TGIFImage License</a> + <a href="#jquery">jQuery License</a> </div> <div class="applies-to"> - Used by <kbd>Src/3rdParty/GIFImage.pas</kbd>. + <kbd>Src/Res/Scripts/3rdParty/jquery-1.12.4.min.js</kbd>. </div> </li> <li> <div class="license-name"> - <a href="#tlistviewex">Vadim Crit's TListViewEx License</a> + <a href="#jquery-cycle">jQuery Cycle Lite Plugin MIT License</a> </div> <div class="applies-to"> - Used by <kbd>Src/3rdParty/LVEx.pas</kbd> and - <kbd>Src/3rdParty/LVEx.res</kbd>. + <kbd>Src/Res/Scripts/3rdParty/jquery.cycle.lite.js</kbd>. + </div> + <div class="indent"> + Note that jQuery Cycle Lite is dual licensed under the MIT or GPL license. It is used here under the MIT license. </div> </li> <li> <div class="license-name"> - <a href="#jquery">jQuery License</a> + <a href="#CC-BY-SA-3.0">Creative Commons Attribution Share Alike 3.0 License</a> + </div> + <div class="applies-to"> + All files in the <kbd>Src/Help/Images</kbd> directory. + </div> + <div class="applies-to"> + All files in the <kbd>Src/Res/Img</kbd> directory. + </div> + <div class="applies-to"> + All files in the <kbd>Src/Res/Img/Egg</kbd> directory. + </div> + <aside> + <div> + This license requires that the images in the above directories should be attributed. To do this + simply note in your documentation, about box, web page or similar that + the images form part of the image set for DelphiDabbler <em>CodeSnip</em> + and provide a link to <a + href="https://delphidabbler.com/software/codesnip" + >https://delphidabbler.com/software/codesnip</a>. + </div> + </aside> + <div class="indent"> + <div> + Some of the image files above include copies, modifications or remixes of third-party images supplied under the following licenses: + </div> + <ul> + <li> + <div class="license-name"> + <a href="#CC-BY-2.5">Creative Commons Attribution 2.5 License</a> + </div> + <div class="applies-to"> + Silk Icon set v1.3. + </div> + <div class="applies-to"> + Silk Companion 1. + </div> + </li> + <li> + <div class="license-name"> + <a href="#CC-BY-SA-3.0">Creative Commons Attribution Share Alike 3.0 + License</a> + </div> + <div class="applies-to"> + Led Icon Set. + </div> + <div class="applies-to"> + Aha-Soft 16x16 Free Application Icons. + </div> + </li> + <li> + <div class="license-name"> + <a href="#toolbar-icons-mit">Toolbar Icons MIT License</a> + </div> + <div class="applies-to"> + Toolbar Icons. + </div> + </li> + </ul> + </div> + <div class="indent"> + Those images originally supplied under the <a href="#CC-BY-2.5">Creative Commons Attribution 2.5 License</a> and the <a href="#toolbar-icons-mit">Toolbar Icons MIT License</a> have been relicensed under the <a href="#CC-BY-SA-3.0">Creative Commons Attribution Share Alike 3.0 License</a>, as is permitted by the licenses. + </div> + </li> + <li> + <div class="license-name"> + <a href="#cc0">CC0 1.0 Universal Public Domain Dedication</a> + </div> + <div class="applies-to"> + All files in the <kbd>Src/Res/Img/AltBranding</kbd> directory. + </div> + <aside> + <div> + These files are provided as placeholder replacements for the identically named files in the <kbd>Src/Res/Img/Branding</kbd> directory that are not permitted to be used in derived programs ("Larger Works"). + </div> + </aside> + <div class="applies-to"> + <kbd>Src/CodeSnip.cfg.tplt</kbd>. + </div> + <div class="applies-to"> + <kbd>Src/CodeSnip.dproj</kbd>. + </div> + <div class="applies-to"> + <kbd>Src/CodeSnip.groupproj</kbd>. </div> <div class="applies-to"> - Used by <kbd>Src/Res/Scripts/3rdParty/jquery-1.8.0.min.js</kbd> + <kbd>Src/CodeSnip.todo</kbd>. + </div> + <div class="applies-to"> + All files in the <kbd>Tests/Src/DUnit</kbd> directory. </div> </li> <li> <div class="license-name"> - <a href="#jquery-cycle">jQuery Cycle Lite Plugin License</a> + <a href="#ddab-exclusive">DelphiDabbler Exclusive Use License</a> + </div> + <div class="applies-to"> + <code>Docs/License.html</code> (this file). + </div> + <div class="indent"> + Any derived applications ("Larger Works") <strong>must</strong> include a license that is compatible with the terms of this license as it relates to any of <em>CodeSnip</em>'s source code that is used in the larger work. </div> <div class="applies-to"> - Used by <kbd>Src/Res/Scripts/3rdParty/jquery.cycle.lite.js</kbd> + All files in the <kbd>Src/Res/Img/Branding</kbd> directory. + </div> + <div class="indent"> + These files comprise the program's icon and splash screen and <strong>must not</strong> be used in, or distributed with, derived programs. + </div> + <aside> + <div> + Identically named images from the <kbd>Src/Res/Img/AltBranding</kbd> directory may be used as replacements in derived programs ("Larger Works"). These images may be freely modified. + </div> + </aside> + </li> + <li> + <div class="license-name"> + <a href="#md5">MD5 License</a> + </div> + <div class="applies-to"> + <kbd>Src/3rdParty/PJMD5.pas</kbd> + </div> + <div class="indent"> + The MD5 License applies to this file <em>in addition</em> to the <a href="#mpl-2.0">Mozilla Public License 2.0</a>. </div> </li> </ul> + + <h3> + Automatically generated files + </h3> <p> - Some 3rd party source code requires attribution. See the - <a href="#required-notices">Required Notices</a> section below. - </p> - <h2> - Images - </h2> - <p> - Numerous images are used in the <em>CodeSnip</em> project. Some are - original while others are copied or modified from third party sources. + Some source files are automatically generated as part of the build process. Such files are not included in the <a href="https://github.com/delphidabbler/codesnip"><em>delphidabbler/codesnip</em></a> repository. </p> <p> - Copies of the images are available in the <a - href="https://github.com/delphidabbler/codesnip" - ><em>CodeSnip</em> GitHub Repository</a> in the - <kbd>Src/Help/Images</kbd> and <kbd>Src/Res/Img</kbd> directories and - sub-directories. These images are licensed as follows: + The license that applies to these files is the same as that of the generating file. The automatically generated files are: </p> <ul> <li> - <div> - The program's icon and splash screen may not be copied or modified and - may not be used in distribution of derived programs without explicit - permission of the copyright holder. - </div> - <div> - This condition applies to all files in the - <kbd>Src/Res/Img/Branding</kbd> directory, all of which are original - work copyright © 2012-2020 by <a - href="https://gravatar.com/delphidabbler" - >Peter D Johnson</a>. - </div> + <kbd>Src/CodeSnip.cfg</kbd>, generated from <kbd>CodeSnip.cfg.tplt</kbd> (<a href="#cc0">CC0</a>). </li> <li> - <div> - Images found in the <kbd>Src/Help/Images</kbd>, <kbd>Src/Res/Img</kbd> - and <kbd>Src/Res/Img/Egg</kbd> directories, are licensed under the - <a href="#CC-BY-SA-3.0">Creative Commons Attribution Share Alike 3.0 - License</a>. - </div> - <div> - The license requires that the images should be attributed. To do this - simply note in your documentation, about box, web page or similar that - the icons form part of the image set for DelphiDabbler <em>CodeSnip</em> - and provide a link to <a - href="https://github.com/delphidabbler/codesnip" - >https://github.com/delphidabbler/codesnip</a>. - </div> - <div> - These images include modifications and remixes of icons supplied under - the following licenses: - </div> - <ul> - <li> - <div class="license-name"> - <a href="#CC-BY-2.5">Creative Commons Attribution 2.5 License</a> - </div> - <div class="applies-to"> - Silk Icon set v1.3 - </div> - <div class="applies-to"> - Silk Companion 1 - </div> - </li> - <li> - <div class="license-name"> - <a href="#CC-BY-SA-3.0">Creative Commons Attribution Share Alike 3.0 - License</a> - </div> - <div class="applies-to"> - Led Icon Set - </div> - <div class="applies-to"> - Aha-Soft 16x16 Free Application Icons - </div> - </li> - <li> - <div class="license-name"> - <a href="#toolbar-icons-mit">Toolbar Icons MIT License</a> - </div> - <div class="applies-to"> - Toolbar Icons - </div> - </li> - </ul> + <kbd>Src/AutoGen/IntfExternalObj.pas</kbd>, generated from <kbd>Src/ExternalObj.ridl</kbd> (<a href="#mpl-2.0">MPL 2.0</a>). </li> </ul> + <h3> + Attribution + </h3> <p> - Some 3rd party image sets require attribution. See the - <a href="#required-notices">Required Notices</a> section below. + Some 3rd party source code and image sets require attribution. Such attributions are provided in the <a href="#required-notices">Required Notices</a> section below. </p> + </section> <section id="open-source-licenses"> @@ -823,7 +868,7 @@ <h3>Exhibit A - Source Code Form License Notice</h3> <blockquote> <p>This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. If a copy of the MPL was not distributed with this file, - You can obtain one at http://mozilla.org/MPL/2.0/.</p> + You can obtain one at https://mozilla.org/MPL/2.0/.</p> </blockquote> <p>If it is not possible or desirable to put the notice in a particular @@ -840,7 +885,7 @@ <h3>Exhibit B - "Incompatible With Secondary Licenses" Notice</h3> Licenses", as defined by the Mozilla Public License, v. 2.0.</p> </blockquote> - <hr /> + <hr> <h2 id="md5"> MD5 License @@ -867,119 +912,7 @@ <h2 id="md5"> <p>These notices must be retained in any copies of any part of this documentation and/or software.</p> - <hr /> - - <h2 id="tgifimage"> - TGIFImage License - </h2> - - <p>TGIFImage is Copyright © 1997-99 Anders Melander. All rights - reserved.</p> - - <p - style="text-decoration: line-through;" - title="No such file was included in the distribution." - >Please see <kbd>copyright.txt</kbd> for additional copyrights. - </p> - - <p>Before proceeding with the installation and/or use of this software, - carefully read the following terms and conditions of this license agreement - and limited warranty (The License).</p> - - <p>By installing or using this software you indicate your acceptance of this - License. If you do not accept or agree with these terms, you may not install - or use this software!</p> - - <h3>License</h3> - - <p>This software, including documentation, source code, object code and/or - additional materials (TGIFImage) is owned by Anders Melander (the Author).</p> - - <p>This License does not provide you with title or ownership of TGIFImage, but - only a right of limited use as outlined in this License agreement. The Author - hereby grants you a non-exclusive, royalty free license to use TGIFImage as - set forth below:</p> - - <ul> - <li>integrate TGIFImage with your Applications, subject to the - redistribution terms below.</li> - - <li>modify or adapt TGIFImage in whole or in part for the development of - Applications based on TGIFImage.</li> - - <li>use portions of the TGIFImage source code or TGIFImage Demo Programs in - your own products.</li> - </ul> - - <h3>Redistribution rights</h3> - - <p>You are granted a non-exclusive, royalty-free right to reproduce and - redistribute executable files created using TGIFImage (the Executable Code) - in conjunction with software products that you develop and/or market (the - Applications).</p> - - <h4>Restrictions</h4> - - <p>Without the expressed, written consent of the Author, you may NOT:</p> - - <ul> - <li>distribute modified versions of TGIFImage, in whole or in part.</li> - - <li>rent or lease TGIFImage.</li> - - <li>sell any portion of TGIFImage on its own, without integrating it into - your Applications as Executable Code.</li> - - <li>bundle TGIFImage with commercial development libraries.</li> - - <li>charge for the value TGIFImage adds to your Applications.</li> - </ul> - - <aside> - <p>TGIFImage v2.2 is now maintained by Finn Tolderlund, <a - href="http://www.tolderlund.eu/delphi/" - >http://www.tolderlund.eu/delphi/</a> with the permission of Anders - Melander.</p> - </aside> - - <h3>Limited warranty</h3> - - <p>There is no warranty or other guarantee of fitness for this software, it is - provided solely "as is". Bug reports or fixes may be submitted, but there is no guarantee they will be acted upon.</p> - - <h3>LZW license</h3> - - <p>GIF (and thus TGIFImage) uses an adaption of the LZW compression algorithm - for image compression. The LZW algorithm is patented by UNISYS. Unfortunately - UNISYS requires royalty payment for all software that uses the LZW - algorithm.</p> - - <p>To avoid the use of the LZW algorithm for writing GIFs, TGIFImage can write - GIFs using a LZW compatible RLE compression method. See the - <var>TGIFImage.Compression</var> property for more information. There are - conflicting opinions on whether a LZW license is required to read GIFs. Some - patent lawyers are of the opinion that the LZW patent does not cover LZW - decoders, but others disagree. If this matters to you, you should contact your - own lawyer.</p> - - <p>For information regarding UNISYS' view on the use of LZW in commercial - software, please read the License Information on GIF and Other LZW-based - Technologies. The UNISYS patent on the LZW algorithm may or may not apply to - you depending on the laws of your country. Personally I have less than warm - feelings for Unisys and their patent and I don't care if you have a license or - not.</p> - - <p>The LZW patent <span style="text-decoration:line-through">expires</span> - expired in 2004.</p> - - <h3>Credit of work</h3> - - <p>If you redistribute TGIFImage in binary form (i.e. as a library or linked - into an application), the accompanying documentation (e.g. readme file, help - file or about-box) should state that This software is based, in part, on the - work of Anders Melander or words to that effect.</p> - - <hr /> + <hr> <h2 id="tlistviewex"> Vadim Crit's TListViewEx License @@ -999,15 +932,15 @@ <h2 id="tlistviewex"> the reference to the original author.</li> </ol> - <hr /> + <hr> <h2 id="jquery"> jQuery License </h2> <p>Copyright 2012 jQuery Foundation and other contributors <a - href="http://jquery.com/" - >http://jquery.com/</a></p> + href="https://jquery.com/" + >https://jquery.com/</a></p> <p>Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the @@ -1028,15 +961,15 @@ <h2 id="jquery"> ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.</p> - <hr /> + <hr> <h2 id="jquery-cycle"> - jQuery Cycle Lite Plugin License + jQuery Cycle Lite Plugin MIT License </h2> <p>Copyright 2008-2012 M. Alsup <a - href="http://malsup.com/jquery/cycle/lite/" - >http://malsup.com/jquery/cycle/lite/</a></p> + href="https://malsup.com/jquery/cycle/lite/" + >https://malsup.com/jquery/cycle/lite/</a></p> <p>Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the @@ -1057,7 +990,7 @@ <h2 id="jquery-cycle"> ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.</p> - <hr /> + <hr> <h2 id="CC-BY-SA-3.0"> Creative Commons Attribution Share Alike 3.0 License @@ -1113,8 +1046,8 @@ <h3><em>License</em></h3> <li><strong>"Creative Commons Compatible License"</strong> means a license that is listed at <a - href="http://creativecommons.org/compatiblelicenses" - >http://creativecommons.org/compatiblelicenses</a> that has been approved by + href="https://creativecommons.org/compatiblelicenses" + >https://creativecommons.org/compatiblelicenses</a> that has been approved by Creative Commons as being essentially equivalent to this License, including, at a minimum, because that license: (i) contains terms that have the same purpose, meaning and effect as the License Elements of this License; and, @@ -1448,12 +1381,12 @@ <h3>Creative Commons Notice</h3> License.</p> <p>Creative Commons may be contacted at <a - href="http://creativecommons.org/" - >http://creativecommons.org/</a>.</p> + href="https://creativecommons.org/" + >https://creativecommons.org/</a>.</p> </aside> <!-- END CC NOTICE --> - <hr /> + <hr> <h2 id="CC-BY-2.5"> Creative Commons Attribution 2.5 License @@ -1722,11 +1655,11 @@ <h2 id="CC-BY-2.5"> available upon request from time to time.</p> <p>Creative Commons may be contacted at <a - href="http://creativecommons.org" - >http://creativecommons.org/</a>.</p> + href="https://creativecommons.org" + >https://creativecommons.org/</a>.</p> </aside> - <hr /> + <hr> <h2 id="toolbar-icons-mit"> Toolbar Icons MIT License @@ -1734,8 +1667,8 @@ <h2 id="toolbar-icons-mit"> <p>Toolbar Icons is made available under the terms of the MIT License. See <a - href="http://toolbaricons.sourceforge.net/" - >http://toolbaricons.sourceforge.net/</a> for more information.</p> + href="https://toolbaricons.sourceforge.net/" + >https://toolbaricons.sourceforge.net/</a> for more information.</p> <p>Copyright © 2010 Florian Haag</p> @@ -1758,20 +1691,129 @@ <h2 id="toolbar-icons-mit"> ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.</p> + <hr> + + <h2 id="cc0"> + CC0 1.0 Universal Public Domain Dedication + </h2> + + <aside> + CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED HEREUNDER. + </aside> + + <h3> + Statement of Purpose + </h3> + + <p> + The laws of most jurisdictions throughout the world automatically confer exclusive Copyright and Related Rights (defined below) upon the creator and subsequent owner(s) (each and all, an "owner") of an original work of authorship and/or a database (each, a "Work"). + </p> + + <p> + Certain owners wish to permanently relinquish those rights to a Work for the purpose of contributing to a commons of creative, cultural and scientific works ("Commons") that the public can reliably and without fear of later claims of infringement build upon, modify, incorporate in other works, reuse and redistribute as freely as possible in any form whatsoever and for any purposes, including without limitation commercial purposes. These owners may contribute to the Commons to promote the ideal of a free culture and the further production of creative, cultural and scientific works, or to gain reputation or greater distribution for their Work in part through the use and efforts of others. + </p> + + <p> + For these and/or other purposes and motivations, and without any expectation of additional consideration or compensation, the person associating CC0 with a Work (the "Affirmer"), to the extent that he or she is an owner of Copyright and Related Rights in the Work, voluntarily elects to apply CC0 to the Work and publicly distribute the Work under its terms, with knowledge of his or her Copyright and Related Rights in the Work and the meaning and intended legal effect of CC0 on those rights. + </p> + + <p> + <strong>1. Copyright and Related Rights.</strong> A Work made available under CC0 may be protected by copyright and related or neighboring rights ("Copyright and Related Rights"). Copyright and Related Rights include, but are not limited to, the following: + </p> + + <ol type="i"> + <li> + the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work; + </li> + <li> + moral rights retained by the original author(s) and/or performer(s); + </li> + <li> + publicity and privacy rights pertaining to a person's image or likeness depicted in a Work; + </li> + <li> + rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below; + </li> + <li> + rights protecting the extraction, dissemination, use and reuse of data in a Work; + </li> + <li> + database rights (such as those arising under Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, and under any national implementation thereof, including any amended or successor version of such directive); and + </li> + <li> + other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof. + </li> + </ol> + + <p> + <strong>2. Waiver.</strong> To the greatest extent permitted by, but not in contravention of, applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and unconditionally waives, abandons, and surrenders all of Affirmer's Copyright and Related Rights and associated claims and causes of action, whether now known or unknown (including existing as well as future claims and causes of action), in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each member of the public at large and to the detriment of Affirmer's heirs and successors, fully intending that such Waiver shall not be subject to revocation, rescission, cancellation, termination, or any other legal or equitable action to disrupt the quiet enjoyment of the Work by the public as contemplated by Affirmer's express Statement of Purpose. + </p> + + <p> + <strong>3. Public License Fallback.</strong> Should any part of the Waiver for any reason be judged legally invalid or ineffective under applicable law, then the Waiver shall be preserved to the maximum extent permitted taking into account Affirmer's express Statement of Purpose. In addition, to the extent the Waiver is so judged Affirmer hereby grants to each affected person a royalty-free, non transferable, non sublicensable, non exclusive, irrevocable and unconditional license to exercise Affirmer's Copyright and Related Rights in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "License"). The License shall be deemed effective as of the date CC0 was applied by Affirmer to the Work. Should any part of the License for any reason be judged legally invalid or ineffective under applicable law, such partial invalidity or ineffectiveness shall not invalidate the remainder of the License, and in such case Affirmer hereby affirms that he or she will not (i) exercise any of his or her remaining Copyright and Related Rights in the Work or (ii) assert any associated claims and causes of action with respect to the Work, in either case contrary to Affirmer's express Statement of Purpose. + </p> + + <p> + <strong>4. Limitations and Disclaimers.</strong> + </p> + + <ol type="a"> + <li> + No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document. + </li> + <li> + Affirmer offers the Work as-is and makes no representations or warranties of any kind concerning the Work, express, implied, statutory or otherwise, including without limitation warranties of title, merchantability, fitness for a particular purpose, non infringement, or the absence of latent or other defects, accuracy, or the present or absence of errors, whether or not discoverable, all to the greatest extent permissible under applicable law. + </li> + <li> + Affirmer disclaims responsibility for clearing rights of other persons that may apply to the Work or any use thereof, including without limitation any person's Copyright and Related Rights in the Work. Further, Affirmer disclaims responsibility for obtaining any necessary consents, permissions or other rights required for any use of the Work. + </li> + <li> + Affirmer understands and acknowledges that Creative Commons is not a party to this document and has no duty or obligation with respect to this CC0 or use of the Work. + </li> + </ol> + </section> <section id="proprietary-source-code"> + <h1> Proprietary Source Code </h1> + + <h2> + Embarcadero + </h2> + <p> <em>CodeSnip</em> is built using <em>Embarcadero Delphi XE</em>. </p> + <p> Original and third party source code make calls to the proprietary Delphi run time library, parts of which are statically linked into the <em>CodeSnip</em> executable. </p> + + <hr> + + <h2 id="ddab-exclusive"> + DelphiDabbler Exclusive Use License + </h2> + + <p> + Files covered by this license are original work, copyright © 2012-2025, <a href="https://gravatar.com/delphidabbler">Peter D Johnson</a>. + </p> + + <p> + Such files <strong>must not</strong> be used, in either original or modified form, in any distribution of a derived program ("Larger Work") without the written permission of the copyright holder. To seek to obtain such permission open an issue on the <em>CodeSnip</em> <a href="https://github.com/delphidabbler/codesnip/issues">Issue Tracker</a>. + </p> + + <aside> + <p> + This restriction does not apply to modifications of <em>CodeSnip</em> that are for personal use only and that are not distributed publicly. + </p> + </aside> + </section> <section id="required-notices"> @@ -1783,9 +1825,6 @@ <h1> The MD5 digest code used in this program is based on the RSA Data Security, Inc. MD5 Message-Digest Algorithm. </li> - <li> - This software is based, in part, on the work of Anders Melander. - </li> <li> The TListViewEx component used in this program is copyright © 1999-2009 Vadim Crits. @@ -1797,20 +1836,16 @@ <h1> </div> <ul> <li> - Silk Icon Set 1.3 by Mark James: <a - href="http://www.famfamfam.com/lab/icons/silk/" - >http://www.famfamfam.com/lab/icons/silk/</a>. + Silk Icon Set 1.3 by Mark James: <del>http://www.famfamfam.com/lab/icons/silk/</del> [link broken]. </li> <li> - Silk Companion 1 by Damien Guard: <del>http://www.damieng.com/icons/silkcompanion</del> [link broken] + Silk Companion 1 by Damien Guard: <del>https://www.damieng.com/icons/silkcompanion</del> [link broken]. </li> <li> Led Icon Set v1.0: <del>http://led24.de/iconset/</del> [link broken]. </li> <li> - 16x16-free-application-icons by Aha-Soft: <a - href="http://www.aha-soft.com" - >http://www.aha-soft.com</a>. + 16x16-free-application-icons by Aha-Soft: <del>https://www.aha-soft.com</del> [link broken]. </li> </ul> </li> @@ -1829,22 +1864,22 @@ <h1> <li> <em>CodeSnip</em>'s installer was created using <em>Inno Setup</em>: see <a - href="http://www.jrsoftware.org/isinfo.php" - >http://www.jrsoftware.org/isinfo.php</a>. + href="https://www.jrsoftware.org/isinfo.php" + >https://www.jrsoftware.org/isinfo.php</a>. </li> <li> - Some program icons are based on the public domain PixelBox icon collection: + Some images are based on the public domain PixelBox icon collection: <del>http://www.icojam.com/blog/?p=222</del> [link broken]. </li> <li> - Some program icons are based on Florian Haag's Toolbar Icons set at <a - href="http://toolbaricons.sourceforge.net/" - >http://toolbaricons.sourceforge.net/</a>. + Some images are based on Florian Haag's Toolbar Icons set at <a + href="https://toolbaricons.sourceforge.net/" + >https://toolbaricons.sourceforge.net/</a>. </li> <li> Some images used in the program's Easter Egg are based on public domain images obtained from <a - href="http://www.clker.com/" + href="https://www.clker.com/" >Clker.com</a>. </li> </ul> diff --git a/Docs/MPL-2.0-Boilerplate.txt b/Docs/MPL-2.0-Boilerplate.txt index a5437f533..9c2d0901a 100644 --- a/Docs/MPL-2.0-Boilerplate.txt +++ b/Docs/MPL-2.0-Boilerplate.txt @@ -1,7 +1,7 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * * Copyright (C) COPYRIGHTDATE, Peter Johnson (gravatar.com/delphidabbler). * @@ -12,7 +12,7 @@ /* * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * * Copyright (C) COPYRIGHTDATE, Peter Johnson (gravatar.com/delphidabbler). * @@ -22,7 +22,7 @@ ; This Source Code Form is subject to the terms of the Mozilla Public License, ; v. 2.0. If a copy of the MPL was not distributed with this file, You can -; obtain one at http://mozilla.org/MPL/2.0/ +; obtain one at https://mozilla.org/MPL/2.0/ ; * Copyright (C) COPYRIGHTDATE, Peter Johnson (gravatar.com/delphidabbler). ; @@ -31,7 +31,7 @@ # This Source Code Form is subject to the terms of the Mozilla Public License, # v. 2.0. If a copy of the MPL was not distributed with this file, You can -# obtain one at http://mozilla.org/MPL/2.0/ +# obtain one at https://mozilla.org/MPL/2.0/ # * Copyright (C) COPYRIGHTDATE, Peter Johnson (gravatar.com/delphidabbler). # @@ -40,7 +40,7 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * * Copyright (C) COPYRIGHTDATE, Peter Johnson (gravatar.com/delphidabbler). * diff --git a/Docs/ReadMe-portable.txt b/Docs/ReadMe-portable.txt new file mode 100644 index 000000000..3365cb371 --- /dev/null +++ b/Docs/ReadMe-portable.txt @@ -0,0 +1,260 @@ +================================================================================ + +DELPHIDABBLER CODESNIP v4 PORTABLE EDITION README + +================================================================================ + + +What is CodeSnip? +================================================================================ + +DelphiDabbler CodeSnip 4 is a code snippets repository targetted at the Pascal / +Delphi programming languages. It can download and display code snippets from the +online DelphiDabbler Code Snippets database as well as maintain a database of +user-defined snippets. + +It displays details of each snippet in the database and can test-compile them +with each installed Win32 version of Delphi from Delphi 2 to Delphi 13.x and +Free Pascal. + +Compilable Pascal units can be created that contain selected snippets. + + +CodeSnip Editions +================================================================================ + +This document relates to the PORTABLE edition of CodeSnip. This edition can be +run from any writeable removable storage medium (e.g. a USB memory stick) or +from any folder on the computer's hard disk. It makes no changes to the host +computer. + +There is also a standard edition of the program. This edition is installed on +the user's computer using an installer. It records its presence in the registry +and stores data in the system's application and user data directories. You can +get the standard edition from the same place you downloaded the this edition. + +You can run both the standard and portable editions together on the same +computer and even run them at the same time. However, each edition maintains its +own settings and keeps its own copies of the snippets databases. To share user +defined snippets you must export them from one edition and import into the +other. CodeSnip provides no mechanism for keeping them synchronised. + + +Installation +================================================================================ + +CodeSnip requires Windows 2000 or later. It also requires MS Internet Explorer 6 +or later, although IE 8, 9 or 10 are strongly recommended. Note that recent +releases have only been tested on Windows 11. + +The portable edition of CodeSnip 4 is distributed in a zip file that contains +the program executable, the help file and various documentation files. + +Install the program using the following steps: + +1) Mount any storage medium on which you want to install CodeSnip. + +2) Create a folder on the storage medium or on your computer's internal disk in + which to copy the required files. + +3) Copy the files CodeSnip-p.exe (the executable program) and CodeSnip.chm + (the help file) into the folder you created. + + CodeSnip does not need the other files included in the zip file in order to + run, but you may find them useful. Copy them if you wish. + +Run the program by double clicking it. When it first runs it will create two +sub-directories within the folder where you installed the program. These will +be named AppData and UserData. Do not remove these directories or alter any of +the contents because CodeSnip uses them to store configuration data along with +your code snippets. + +No files are written outside the folder where you copied the files and the +registry is not modified. + +** WARNING: When updating an existing portable installation with a new version +of CodeSnip it is important that you do not change or delete the AppData and +UserData folders. If you do this you risk loosing your settings and/or database. + + +Uninstallation +================================================================================ + +Simply delete the folder where you installed the portable edition of CodeSnip +along with all its contents. + +Be aware that any snippets you have created will be lost. If you want to keep +them for use in another CodeSnip installation, either export them or back up the +user database before deleting the folder. See the help file for details of how +to do this. + + +Downloading & Updating the Code Snippets Database +================================================================================ + +The online DelphiDabbler Code Snippets database is not installed with the +program. + +CodeSnip's start-up screen shows details of any installed databases. If there is +no copy of the online database then a link is displayed that enables the +database to be installed. This link opens the "Install or Update DelphiDabbler +Snippets Database" wizard dialogue box. The dialogue box explains how to +download and install the database. + +You can download or update the database later by opening the same dialogue box +using the "Database | Install or Update DelphiDabbler Snippets Database" menu +option. + + +Configuring CodeSnip to Work With Your Compilers +================================================================================ + +A feature of CodeSnip is its ability to test compile snippets with any installed +Windows 32 version of Delphi (from Delphi 2 to Delphi.x) and FreePascal, +providing some simple rules are followed. + +When CodeSnip is first installed it knows nothing about the available compilers +and so test compilations cannot be performed. If any supported Delphi compiler +is detected when the program is first run you will be given the option of +registering it. This does not work for Free Pascal. + +You can also tell CodeSnip about the available compilers by using the "Tools | +Configure Compilers" menu option. The resulting dialogue can automatically +detect all installed versions of supported Delphi compilers at the click of a +button. Free Pascal, where installed, must be set up manually. The Welcome page +displays a list of compilers it has been configured to work with. + +Compilers that do not use English as their output language will need further +configuration. See the help file for information (look up "configure compilers +dialogue" in the help file index). + +Each user can configure compilers differently. + +Delphi XE2 and later may need to be configured to search for required units in +the correct namespaces. This is explained in the Add/Edit Snippet Dialogue Box +help topic and in the FAQ at +https://github.com/delphidabbler/codesnip-faq/blob/master/UsingCodeSnip.md#faq-7 + +Any type of snippet other than "freeform" can be test compiled. + + +Updating the Program +================================================================================ + +Updates are published on GitHub. See +https://github.com/delphidabbler/codesnip/releases + +News of new updates is published on the DelphiDabbler Blog: +https://delphidabbler.blogspot.com/. + + +Known Installation and Upgrading Issues +================================================================================ + ++ If you have updated to CodeSnip v4.2.0 or later from any earlier v4 release, + and then run the earlier version of the program again, its saved main window + state, size, position and layout will have been lost and the program will + display in its default size. + ++ If you have updated to CodeSnip v4.3.0 or later from v4.2.x or earlier any -NS + command line options you have specified on the "Switches" (aka "Command Line") + tab of the Configure Compilers dialogue box for Delphi XE2 or later will be + removed and equivalent entries will have been made on the "Namespaces" tab. + ++ CodeSnip v4.16.0 and later cannot be registered. Any previous registration + information may be lost. + + +License & Disclaimer +================================================================================ + +CodeSnip is made available under the terms of the Mozilla Public License v2.0. +The license is explained in full in the file License.html that is installed with +CodeSnip. A summary of the license can be viewed from the "Help | License" menu +option. + +CodeSnip is supplied on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either +express or implied. See License.html for details. + +The source code of any snippet managed by CodeSnip, whether from the +DelphiDabbler Code Snippets Database or the user database, is used WITHOUT +WARRANTY OF ANY KIND, either express or implied. The code is used entirely at +the user's own risk. + +The snippets from the DelphiDabbler Code Snippets Database are open source. See +the "About The Database" tab of the About dialogue box for details of the +applicable license. (You can display the About box from the "Help" menu.) + +The user is responsible to ensure that any code snippets managed by CodeSnip are +used in accordance with any applicable license. + + +Source Code +================================================================================ + +CodeSnip's source code is freely available. For details of how to obtain the +source see the FAQ at +https://github.com/delphidabbler/codesnip-faq/blob/master/SourceCode.md#faq-1 + +The portable edition of CodeSnip shares the same source code base with the +standard edition. + +The original source code of v4 is released under the Mozilla Public license +v2.0 (see https://www.mozilla.org/MPL/) and other open source licenses. See the +file "License.html" in the "Docs" directory of the repository for full licensing +information. + + +Bugs & Feature Requests +================================================================================ + +Please do report any bugs you find. Suggestions for new features are also +welcomed. + +Both bug reports and feature requests are made using the GitHub issue tracker +(GitHub account required). For details about using the issue tracker see +https://github.com/delphidabbler/codesnip/blob/master/CONTRIBUTING.md#issues. + + +FAQs +================================================================================ + +There are Frequently Asked Questions pages for CodeSnip on the web, at +https://github.com/delphidabbler/codesnip-faq/blob/master/README.md + + +Privacy +================================================================================ + +From v4.16.0 CodeSnip neither stores nor transmits any personally identifiable +data. + +Do note though that CodeSnip can display web pages via your default web browser, +but only in response to user input. No guarantee is made about any personal data +collected by such web pages. + + +Thanks +================================================================================ + +Thanks to: + ++ David Mustard and Bill Miller for providing information that enabled me to add + Delphi 2007 and Delphi 2009 support, respectively, to the program. + ++ geoffsmith82 and an anonymous contributor for information about getting + CodeSnip to work with Delphi XE2. + ++ The authors of the third party source code and images used by the program. See + the program's about box or License.html for details. + ++ SirRufo for helping to fix a long standing bug where CodeSnip would crash on + resuming from hibernation. + ++ Various contributors to the DelphiDabbler Code Snippets database. Names of + contributors are listed in the program's About Box (use the "Help | About" + menu option then select the "About the Database" tab). The list will be empty + if the Code Snippets Database has not been installed. + + +================================================================================ diff --git a/Docs/ReadMe.txt b/Docs/ReadMe-standard.txt similarity index 55% rename from Docs/ReadMe.txt rename to Docs/ReadMe-standard.txt index 3a4abd81f..4b84aaaca 100644 --- a/Docs/ReadMe.txt +++ b/Docs/ReadMe-standard.txt @@ -1,6 +1,6 @@ ================================================================================ -DELPHIDABBLER CODESNIP v4 README +DELPHIDABBLER CODESNIP v4 STANDARD EDITION README ================================================================================ @@ -14,30 +14,26 @@ online DelphiDabbler Code Snippets database as well as maintain a database of user-defined snippets. It displays details of each snippet in the database and can test-compile them -with each installed Win32 version of Delphi from Delphi 2 to Delphi 10.4 Sydney -and Free Pascal. +with each installed Win32 version of Delphi from Delphi 2 to Delphi 13.x and +Free Pascal. Compilable Pascal units can be created that contain selected snippets. -Features new to CodeSnip 4 are listed in the "What's New In CodeSnip 4" topic -in the program's help file. - CodeSnip Editions ================================================================================ -There are two different editions of CodeSnip 4 available: - -+ The standard edition, which is installed on the user's computer using an - installer and which records its presence in the registry and stores data in - the system's application and user data directories. +This document relates to the STANDARD edition of CodeSnip. This edition is +installed on the user's computer using a standard Windows installer and which +records its presence in the registry and stores data in the system's application +and user data directories. -+ The portable edition that can be run from any writeable removable storage - medium (e.g. a USB memory stick) and that makes no changes to the host - computer. This edition has no installer and is simply copied onto the required - medium. +There is also a portable edition of the program. This edition can be run from +any writeable removable storage medium (e.g. a USB memory stick) or from any +folder on the computer's hard disk. It makes no changes to the host computer. +This edition has no installer and is simply copied to the required location. -You can run both the standard and portable editions together on the same +You can run both the portable and standard editions together on the same computer and even run them at the same time. However, each edition maintains its own settings and keeps its own copies of the snippets databases. To share user defined snippets you must export them from one edition and import into the @@ -48,17 +44,14 @@ Installation ================================================================================ CodeSnip requires Windows 2000 or later. It also requires MS Internet Explorer 6 -or later, but IE 8, 9 or 10 are strongly recommended. +or later, although IE 8, 9 or 10 are strongly recommended. Note that recent +releases have only been tested on Windows 11. -Installing the Standard Edition -------------------------------- - -You will need administrator privileges to run the setup program for the standard -edition. If you are using a non-admin user account on Windows 2000 or XP you -should run setup as administrator. By default Windows Vista to Windows 10 will -require an admin password if running as a standard user and setup will attempt -to elevate the process. If UAC prompts are disabled you must run setup as -administrator. +You will need administrator privileges to run the setup program. If you are +using a non-admin user account on Windows 2000 or XP you should run setup as +administrator. By default Windows Vista to Windows 11 will require admin +privileges and setup will attempt to elevate the process if required. If UAC +prompts are disabled you must run setup as administrator. CodeSnip v4 will install alongside any v3 or earlier release that may already be installed. If you want to replace the earlier version simply uninstall it in the @@ -66,8 +59,8 @@ usual way. Uninstalling v3 or earlier after installing v4 will have no adverse affect on v4. CodeSnip's installation program is named codesnip-setup-4.x.x.exe, where x.x -is the program's minor version number. The install program may be distributed in -a zip file. +is the program's minor version number. The install program is distributed in a +zip file. Close any running instance of CodeSnip, run the install program then follow the on-screen instructions. @@ -80,9 +73,9 @@ The installer makes the following changes to your system: + Files required by the uninstaller are stored in the main installation's Uninst sub-folder. -+ The program's uninstall information is registered with the "Apps and Features" - (a.k.a. "Programs and Features", a.k.a. "Add / Remove Programs") control panel - applet. ++ The program's uninstall information is registered with the "Installed App" + (a.k.a. "Apps and Features", a.k.a. "Programs and Features", a.k.a. "Add / + Remove Programs") control panel app. + A program group may be created in the start menu (optional). @@ -105,51 +98,15 @@ If you are updating to CodeSnip 4 from version 3 or earlier, CodeSnip will give you the option of bringing forward your old settings and / or user defined database. This happens the first time v4 is run for each user. -Installing the Portable Edition -------------------------------- - -The portable edition of CodeSnip 4 is distributed in a zip file that contains -the program executable, the help file and various documentation files. - -Install the program using the following steps: - -1) Mount the storage medium on which you want to install CodeSnip. - -2) Create a folder on the storage medium in which to copy the required files. - -3) Copy the files CodeSnip-p.exe (the executable program) and CodeSnip.chm - (the help file) into the folder you created. - - CodeSnip does not need the other files included in the zip file in order to - run, but you may find them useful. Copy them if you wish. - -Run the program by double clicking it. When it first runs it will create two -sub-directories within the folder where you installed the program. These will -be named AppData and UserData. Do not remove these directories or alter any of -the contents. CodeSnip uses them to store configuration data along with your -code snippets. - -No files are written outside the folder where you copied the files and the -registry is not modified. - -** WARNING: When updating an existing portable installation with a new version -of CodeSnip it is important that you do not change or delete the AppData and -UserData folders. If you do this you risk loosing your settings and/or database. - Uninstallation ================================================================================ -Uninstalling the Standard Edition ---------------------------------- - -CodeSnip can be uninstalled via "Apps and Features" (a.k.a. "Programs and -Features", a.k.a. "Add / Remove Programs") from the Windows Control Panel or by -choosing "Uninstall DelphiDabbler CodeSnip" from the program's start menu group. +CodeSnip can be uninstalled using your version of Windows' application +uninstaller, run from Control Panel. Alternatively you can choose "Uninstall +DelphiDabbler CodeSnip" from the program's start menu group. -Administrator privileges will be required to uninstall CodeSnip. Windows Vista -to Windows 10 with UAC prompts enabled will prompt for an admin password if -necessary. +Administrator privileges will be required to uninstall CodeSnip. The uninstall program will delete any local copy of the online Code Snippets database but will leave any user defined database, configuration data and @@ -158,16 +115,6 @@ delete the %AppData%\DelphiDabbler\CodeSnip.4 directory and all its contents for each user who ran CodeSnip. If any user has moved the user database directory those directories also need to be deleted. -Uninstalling the Portable Edition ---------------------------------- - -Simply delete the folder where you installed CodeSnip, with all its contents. - -Be aware that any snippets you have created will be lost. If you want to keep -them for use in another CodeSnip installation either export them or back up the -user database before deleting the folder. See the help file for details of how -to do this. - Downloading & Updating the Code Snippets Database ================================================================================ @@ -176,22 +123,19 @@ The online DelphiDabbler Code Snippets database is not installed with the program. CodeSnip's start-up screen shows details of any installed databases. If there is -no copy of the online database a link is displayed that enables the database to -be installed. This link opens the "Install or Update DelphiDabbler Snippets -Database" wizard style dialogue box. The dialogue box explains how to download -and install the database. +no copy of the online database then a link is displayed that enables the +database to be installed. This link opens the "Install or Update DelphiDabbler +Snippets Database" wizard dialogue box. The dialogue box explains how to +download and install the database. You can download or update the database later by opening the same dialogue box using the "Database | Install or Update DelphiDabbler Snippets Database" menu option. -Standard Edition Only ---------------------- - -When installing the standard edition, the setup program will detect if an older -database installation is present and will give the option to carry it forward. -When setup completes it checks for the presence of the database and puts up a -message if it is not present. +During installation the setup program will detect if an older database version +is present and will give the option to carry it forward. When setup completes it +checks for the presence of the database and puts up a message if it is not +present. Database updates will apply to all users of the computer the next time they start CodeSnip. @@ -201,16 +145,19 @@ Configuring CodeSnip to Work With Your Compilers ================================================================================ A feature of CodeSnip is its ability to test compile snippets with any installed -Windows 32 version of Delphi (from Delphi 2 to Delphi 10.4 Sydney) and -FreePascal, providing some simple rules are followed. +Windows 32 version of Delphi (from Delphi 2 to Delphi.x) and FreePascal, +providing some simple rules are followed. When CodeSnip is first installed it knows nothing about the available compilers -and so test compilations cannot be performed. You must tell CodeSnip about the -available compilers by using the "Tools | Configure Compilers" menu option. The -resulting dialogue can automatically detect all installed versions of supported -Delphi compilers at the click of a button. Free Pascal, where installed, must be -set up manually. The Welcome page displays a list of compilers it has been -configured to work with. +and so test compilations cannot be performed. If any supported Delphi compiler +is detected when the program is first run you will be given the option of +registering it. This does not work for Free Pascal. + +You can also tell CodeSnip about the available compilers by using the "Tools | +Configure Compilers" menu option. The resulting dialogue can automatically +detect all installed versions of supported Delphi compilers at the click of a +button. Free Pascal, where installed, must be set up manually. The Welcome page +displays a list of compilers it has been configured to work with. Compilers that do not use English as their output language will need further configuration. See the help file for information (look up "configure compilers @@ -218,10 +165,10 @@ dialogue" in the help file index). Each user can configure compilers differently. -Delphi XE2 to XE8 and Delphi 10.4 Sydney may need to be configured to search for -required units in the correct namespaces. This is explained in the Add/Edit -Snippet Dialogue Box help topic and in the FAQ at -https://github.com/delphidabbler/codesnip-faq/blob/master/UsingCodeSnip.md#faq-1 +Delphi XE2 and later may need to be configured to search for required units in +the correct namespaces. This is explained in the Add/Edit Snippet Dialogue Box +help topic and in the FAQ at +https://github.com/delphidabbler/codesnip-faq/blob/master/UsingCodeSnip.md#faq-7 Any type of snippet other than "freeform" can be test compiled. @@ -229,14 +176,11 @@ Any type of snippet other than "freeform" can be test compiled. Updating the Program ================================================================================ -Updates are published on: - -+ GitHub: https://github.com/delphidabbler/codesnip/releases +Updates are published on GitHub. See +https://github.com/delphidabbler/codesnip/releases -+ SourceForge: https://sourceforge.net/projects/codesnip/files/ - -News of new updates is published on the CodeSnip Blog: -http://codesnip-app.blogspot.com/. +News of new updates is published on the DelphiDabbler Blog: +https://delphidabbler.blogspot.com/. Known Installation and Upgrading Issues @@ -245,14 +189,14 @@ Known Installation and Upgrading Issues + Any syntax highlighter customisation you have made will be lost if you are updating from any v2 or earlier. - You will need to redo any customisation using the "Syntax Highlighter" tab of + You will need to redo any customisation using the "Syntax Highlighter" page of the Preferences dialogue box displayed from the "Tools | Preferences" menu option. + Your source code formatting preferences will have been lost if you are updating from v1.7.4 or earlier. - You will need to reconfigure them using the "Code Formatting" tab of the + You will need to reconfigure them using the "Code Formatting" page of the Preferences dialogue box displayed from the "Tools | Preferences" menu option. + If you have updated to CodeSnip v4.2.0 or later from any earlier v4 release, @@ -285,7 +229,7 @@ DelphiDabbler Code Snippets Database or the user database, is used WITHOUT WARRANTY OF ANY KIND, either express or implied. The code is used entirely at the user's own risk. -The snippets from the DelphiDabbler Code Snippets Database is open source. See +The snippets from the DelphiDabbler Code Snippets Database are open source. See the "About The Database" tab of the About dialogue box for details of the applicable license. (You can display the About box from the "Help" menu.) @@ -300,45 +244,24 @@ CodeSnip's source code is freely available. For details of how to obtain the source see the FAQ at https://github.com/delphidabbler/codesnip-faq/blob/master/SourceCode.md#faq-1 -The standard and portable editions of CodeSnip share the same source code. +The standard edition of CodeSnip shares the same source code base with the +portable edition. The original source code of v4 is released under the Mozilla Public license -v2.0 (see http://www.mozilla.org/MPL/) and other open source licenses. See the +v2.0 (see https://www.mozilla.org/MPL/) and other open source licenses. See the file "License.html" in the "Docs" directory of the repository for full licensing information. -Bugs +Bugs & Feature Requests ================================================================================ -Please do report any bugs you find. - -Bugs are recorded in tracker software. View the reported and fixed bugs via -https://github.com/delphidabbler/codesnip/issues (GitHub account required). - -You can also access the bug tracker from CodeSnip by using the "Tools | Report -Bug Online" menu option then following the link that appears in the resulting -dialogue box. - -If you wish to report a bug, please check the current reports on the bug -tracker. If your bug hasn't already been reported or fixed please add a report -using the "Add new" link on Tracker. +Please do report any bugs you find. Suggestions for new features are also +welcomed. -Please note that version 4.15.1 and earlier are no longer supported, so don't -report bugs for those versions. You should update the program first and only -report the bug if it is still present. - - -Feedback -================================================================================ - -If you want to suggest new features please use the feature request tracker -accessed from https://github.com/delphidabbler/codesnip/issues (GitHub account -required). Please check whether anyone else has requested something similar and -add a comment to their request if so. - -Always check the latest version of CodeSnip before requesting a feature just in -case it has already been implemented! +Both bug reports and feature requests are made using the GitHub issue tracker +(GitHub account required). For details about using the issue tracker see +https://github.com/delphidabbler/codesnip/blob/master/CONTRIBUTING.md#issues. FAQs @@ -351,15 +274,12 @@ https://github.com/delphidabbler/codesnip-faq/blob/master/README.md Privacy ================================================================================ -As of v4.16.0 CodeSnip no longer stores or transmits any personally identifiable +From v4.16.0 CodeSnip neither stores nor transmits any personally identifiable data. -Because of this change the privacy statement that used to be provided with the -program has been removed. - -Do note though that CodeSnip can display web pages via your default web -browser, but only in response to user input. No guarantee is made about any -personal data collected by such web pages. +Do note though that CodeSnip can display web pages via your default web browser, +but only in response to user input. No guarantee is made about any personal data +collected by such web pages. Thanks @@ -373,13 +293,16 @@ Thanks to: + geoffsmith82 and an anonymous contributor for information about getting CodeSnip to work with Delphi XE2. ++ SirRufo for helping to fix a long standing bug where CodeSnip would crash on + resuming from hibernation. + + The authors of the third party source code and images used by the program. See the program's about box or License.html for details. + Various contributors to the DelphiDabbler Code Snippets database. Names of contributors are listed in the program's About Box (use the "Help | About" - menu option then select the "About the Database" tab). If the list is empty - then updating the Code Snippets Database will download the details. + menu option then select the "About the Database" tab). The list will be empty + if the Code Snippets Database has not been installed. ================================================================================ diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 9074c751d..000000000 --- a/LICENSE +++ /dev/null @@ -1,20 +0,0 @@ -Licensing of CodeSnip's source and image files is on a per file basis. - -There are two ways that license information can be found: - -1) By examining comments within source files. License information will be at or - near the beginning of the file. - -2) By reading any LICENSE file that exists in the same directory as the files - you are interested in, or if no such file exists, in a parent directory. - The "nearest" LICENSE file takes precedence. - - A LICENSE file is used to provide license information for source files that - have no (or unclear) embedded information and for images and other files that - do not have human-readable content. - -If any information is missing or incorrect please inform the author by filling -in a bug report at https://github.com/delphidabbler/codesnip/issues - -If you are planning on re-using any of the CodeSnip source, detailed licensing -information will be found in Docs/License.html. \ No newline at end of file diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 000000000..94996ab7c --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,11 @@ +# CodeSnip License + +Executable releases of CodeSnip are released under the terms of the [Mozilla Public License 2.0](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/master/Docs/License.html#mpl-2.0). + +Much of CodeSnip's source code is released under the same license, although other open source licenses are also used. + +There are restrictions on using CodeSnip's branding in any independent forks of the program. + +For definitive details see the [full license text](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/master/Docs/License.html). + +A copy of the full license text is included with each CodeSnip executable. The original document can be found in the file `Docs/License.html` in the [_delphidabbler/codesnip_](https://github.com/delphidabbler/codesnip) repository on GitHub. diff --git a/README.md b/README.md index fef54e5d7..4110004a2 100644 --- a/README.md +++ b/README.md @@ -6,86 +6,84 @@ A code bank designed with Pascal in mind. * [Installation](#installation) * [Support](#support) * [Source Code](#source-code) +* [Compiling](#compiling) +* [Contributing](#contributing) * [Change Log](#change-log) * [License](#license) -* [Bug Reports and Features](#bug-reports-and-features) +* [Bug Reports and Feature Requests](#bug-reports-and-feature-requests) ## Overview -CodeSnip is an open source code bank for storing and viewing your code snippets. While it can manage snippets in any source language, it is focussed mainly on Pascal and Delphi code for which additional features are available. - -CodeSnip can import code from the DelphiDabbler [Code Snippets Database](https://github.com/delphidabbler/code-snippets). +CodeSnip is an open source code bank for storing and viewing your code snippets. While it can manage snippets in any source language, it is focused mainly on Pascal and Delphi code for which additional features are available. The program is available in both standard and portable editions. -CodeSnip requires Windows 2000 or later and Internet Explorer 6 or later, although XP and IE 8 and later are preferred. +CodeSnip can import code from the DelphiDabbler [Code Snippets Database](https://github.com/delphidabbler/code-snippets) and the [SWAG Pascal Code Collection](https://github.com/delphidabbler/swag). ## Installation -The standard edition of CodeSnip is installed and removed using a standard Windows installer. Administrator privileges are required for installation. +The standard edition of CodeSnip is installed and removed using a Windows installer. Administrator privileges are required for installation. + +The portable edition has no installer. Simply follow the instructions in the [read me file](https://raw.githubusercontent.com/delphidabbler/codesnip/master/Docs/ReadMe-portable.txt) that is included in the download. -The portable edition has no installer. Simply follow the instructions in the [read me file](https://github.com/delphidabbler/codesnip/blob/master/Docs/ReadMe.txt) that is included in the download zip file. +The program _should_ run on Windows 2000, with Internet Explorer 6 or later, although XP and IE 8 and later are recommended. _But_ note that recent releases of CodeSnip have only been tested on Windows 10 & 11. ## Support -The following support is available CodeSnip users: +The following support is available to CodeSnip users: * A comprehensive help file. -* A [read-me file](https://raw.githubusercontent.com/delphidabbler/codesnip/master/Docs/ReadMe.txt)<sup> *</sup> that discusses installation, configuration, updating and known issues. -* A [Using CodeSnip FAQ](https://github.com/delphidabbler/codesnip-faq/blob/master/UsingCodeSnip.md). -* A [Blog](http://codesnip-app.blogspot.co.uk/). +* A read-me file that discusses installation, configuration, updating and known issues. There are different versions of this file for each edition of CodeSnip: one for the [standard edition](https://raw.githubusercontent.com/delphidabbler/codesnip/master/Docs/ReadMe-standard.txt) and another for the [portable edition](https://raw.githubusercontent.com/delphidabbler/codesnip/master/Docs/ReadMe-portable.txt). [^1] +* The [Using CodeSnip FAQ](https://github.com/delphidabbler/codesnip-faq/blob/master/UsingCodeSnip.md). +* The [DelphiDabbler Blog](https://delphidabbler.blogspot.co.uk/) that provides CodeSnip news. +* CodeSnip's own [Web Page](https://delphidabbler.com/software/codesnip). There's also plenty of info available on how to compile CodeSnip from source - see below. -<sup>*</sup> These links take you to the most recent version of the documents -- they can change from release to release. +> [^1]: The linked read-me file is the most recent version. It can change from release to release. ## Source Code -CodeSnip's source code is maintained in the [`delphidabbler/codesnip`](https://github.com/delphidabbler/codesnip) Git repository on GitHub†. +CodeSnip's source code is maintained in the [`delphidabbler/codesnip`](https://github.com/delphidabbler/codesnip) Git repository on GitHub. [^2] -[Git Flow](http://nvie.com/posts/a-successful-git-branching-model/) methodology has been adopted, with the exception of some branches that have been used in abortive attempts to start work on CodeSnip 5. +The [Git Flow](https://nvie.com/posts/a-successful-git-branching-model/) methodology has been adopted for CodeSnip 4 development. The following branches are used: -The following branches existed at the time when CodeSnip v4.16.0 was released: +* [`master`](https://github.com/delphidabbler/codesnip/tree/master): Always reflects the state of the source code as of the latest release. [^3] +* [`develop`](https://github.com/delphidabbler/codesnip/tree/develop): The head of this branch contains the latest v4 development code. Normal development of CodeSnip 4 takes place in feature branches that are then merged into `develop`. +* Feature branches, with names of the form `feature/<feature-name>`. Normally such branches are only used locally, but occasionally some feature branches may be pushed to the main repository. -* `master`: Always reflects the state of the source code as of the latest release.‡ -* `develop`: Main development branch. The head of this branch contains the latest development code. -* `pagoda`: An abortive attempt at developing CodeSnip 5. Work on this branch has halted. It does not follow GitFlow methodology. ***Do not use this branch: it may be pruned.*** -* `pavilion`: Another attempt at working on CodeSnip 5. It branched off `pagoda` and it's future is uncertain. Again it does not follow GitFlow methodology. +You will find other branches in the repository. These are either experimental or abandoned. To find out more about them switch to the required branch and read its `README.md` file. -New features and most bug fixes are worked on in `feature/xxxx` branches locally. They are merged into `develop` as they are completed and the branches are deleted. +> [^2]: Up to and including v4.13.1 the source code was kept in a Subversion repository on SourceForge. It was converted to Git in October 2015 and imported into GitHub. All releases from v3.0.0 are marked by tags in the form `version-x.x.x` where `x.x.x` is the version number. None of the Subversion branches made it through the conversion to Git, so to see a full history look at the old [SourceForge repository](https://sourceforge.net/p/codesnip/code/). -**Note** that the default branch on GitHub is `develop` rather than `master`. This is because that's where all the work takes place. If you want to see the state of play at the last release make sure to switch to `master`. +> [^3]: All the converted Subversion code was committed to `master`, making it a copy of the old Subversion `trunk`. As such `master` contains various development commits along with numerous commits related to management of Subversion. After release 4.13.1, and the the first commit of this read-me file, `master` contains only commits relating to actual releases. -> † Up to and including v4.13.1 the source code was kept in a Subversion repository on SourceForge. It was converted to Git in October 2015 and imported into GitHub. All releases from v3.0.0 are marked by tags in the form `version-x.x.x` where `x.x.x` is the version number. None of the Subversion branches made it through the conversion to Git, so to see a full history look at the old [SourceForge repository](https://sourceforge.net/p/codesnip/code/). +## Compiling -> ‡ All the converted Subversion code was committed to `master`, making it a copy of the old Subversion `trunk`. As such `master` contains various development commits along with numerous commits related to management of Subversion. After release 4.13.1, and the the first commit of this read-me file, `master` contains only commits relating to actual releases. +If you want to compile CodeSnip 4 from source code you will need the rather long-in-the-tooth Delphi XE. See [this FAQ](https://github.com/delphidabbler/codesnip-faq/blob/master/SourceCode.md#faq-11) to find out why. -### Contributions +Full instructions on setting up the build environment are provided in [`Build.html`](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/develop/Build.html). -To contribute to the project please fork the repository on GitHub. Create a feature branch off the `develop` branch. Make your changes to the feature branch then submit a pull request via GitHub. +## Contributing -### Compiling +Please see [`CONTRIBUTING.md`](https://github.com/delphidabbler/codesnip/blob/develop/CONTRIBUTING.md) for details of how to contribute to the CodeSnip project. -`master` has a file in the root directory named [`Build.html`](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/master/Build.html) that gives detailed information about how to compile the current release of CodeSnip. - -There is also a [Compiling & Source Code FAQ](https://github.com/delphidabbler/codesnip-faq/blob/master/SourceCode.md). +â›” Contributions to experimental and abandoned branches are not accepted. ## Change Log -The program's current change log can be found in the file `CHANGELOG.md` in the root of the `master` branch. +The change log can be found in the file [`CHANGELOG.md`](https://github.com/delphidabbler/codesnip/blob/master/CHANGELOG.md). [^4] -> Note that CodeSnip v4.15.1 and earlier did not have `CHANGELOG.md`. Instead, some versions maintained a separate change log for each major version in the `Docs/ChangeLogs` directory. +> [^4]: CodeSnip v4.15.1 and earlier did not have `CHANGELOG.md`. Instead, some versions maintained a separate change log for each major version in the `Docs/ChangeLogs` directory. ## License -The program's EULA, which gives full details of the license applying to the latest release, can be found in the file [`Docs\License.html`](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/master/Docs/License.html) in the `master` branch. The license has changed between releases, so if you need to see an older one, select the appropriate `version-x.x.x` tag and read the older version of the file. - -Most of the original code is made available under the [Mozilla Public License v2](https://www.mozilla.org/MPL/2.0/). +A summary of CodeSnip's license can be found in [`LICENSE.md`](https://github.com/delphidabbler/codesnip/blob/master/LICENSE.md) and the complete license text is in [`Docs\License.html`](https://htmlpreview.github.io/?https://github.com/delphidabbler/codesnip/blob/master/Docs/License.html). [^5] -The [CodeSnip Compiling & Source Code FAQ](https://github.com/delphidabbler/codesnip-faq/blob/master/SourceCode.md) may be useful if you have any queries about re-using CodeSnip source in other projects. +> [^5]: The linked license files relate to the latest release. However, the license file names and content can change between releases, so if you need to see an older version, select the relevant `version-x.x.x` tag to find the appropriate file. -## Bug Reports and Features +The [CodeSnip Compiling & Source Code FAQ](https://github.com/delphidabbler/codesnip-faq/blob/master/SourceCode.md) may be useful if you have any queries about re-using the CodeSnip source code in other projects. -You can report bugs or request new features using the [Issues section](https://github.com/delphidabbler/codesnip/issues) of the CodeSnip GitHub project. You will need a GitHub account to do this. +## Bug Reports and Feature Requests -Please do not report bugs unless you have checked whether the bug exists in the latest version of the program. +Report bugs and requests for new features are welcome. Please see the [Issues section of `CONTRIBUTING.md`](https://github.com/delphidabbler/codesnip/blob/develop/CONTRIBUTING.md#issues) for information about how to proceed. diff --git a/Src/3rdParty/GIFImage.pas b/Src/3rdParty/GIFImage.pas deleted file mode 100644 index 1fbe8a80c..000000000 --- a/Src/3rdParty/GIFImage.pas +++ /dev/null @@ -1,12957 +0,0 @@ -unit GIFImage; -//////////////////////////////////////////////////////////////////////////////// -// // -// Project: GIF Graphics Object // -// Module: gifimage // -// Description: TGraphic implementation of the GIF89a graphics format // -// Version: 2.2 // -// Release: 5 // -// Date: 23-MAY-1999 // -// Target: Win32, Delphi 2, 3, 4 & 5, C++ Builder 3 & 4 // -// Author(s): anme: Anders Melander, anders@melander.dk // -// fila: Filip Larsen // -// rps: Reinier Sterkenburg // -// Copyright: (c) 1997-99 Anders Melander. // -// All rights reserved. // -// Formatting: 2 space indent, 8 space tabs, 80 columns. // -// // -//////////////////////////////////////////////////////////////////////////////// -// Changed 2001.07.23 by Finn Tolderlund: // -// Changed according to e-mail from "Rolf Frei" <rolf@eicom.ch> // -// on 2001.07.23 so that it works in Delphi 6. // -// // -// Changed 2002.07.07 by Finn Tolderlund: // -// Incorporated additional modifications by Alexey Barkovoy (clootie@reactor.ru) -// found in his Delphi 6 GifImage.pas (from 22-Dec-2001). // -// Alexey Barkovoy's Delphi 6 gifimage.pas can be downloaded from // -// http://clootie.narod.ru/delphi/download_vcl.html // -// These changes made showing of animated gif files more stable. The code // -// from 2001.07.23 could crash sometimes with an Execption EAccessViolation. // -// // -// Changed 2002.10.06 by Finn Tolderlund: // -// Delphi 7 compatible. // -// // -// Changed 2003-03-06 by Finn Tolderlund: // -// Changes made as a result of postings in borland.public.delphi.graphics // -// from 2003-02-28 to 2003-03-05 where white (255,255,255) in a bitmap // -// was converted to (254,254,254) in the gif. // -// The doCreateOptimizedPaletteFromSingleBitmap function and // -// the CreateOptimizedPaletteFromManyBitmaps function is changed so that // -// the correct offset 246 is used instead of 245. // -// The ReduceColors function is changed according to Anders Melander's post // -// so that a colour get converted to the precise colour if that colour is // -// present in the palette when using ColorReduction rmQuantize. // -// // -// Changed 2003-03-09 by Finn Tolderlund: // -// Delphi 7 version is now assumed if unknown compiler version is unknown // -// for better compatibility with future Delphi versions. // -// Hopefully this code is now compatible with future Delphi versions, // -// unless Borland makes some changes that breaks existing code. // -// // -// Changed 2003-08-04 by Finn Tolderlund: // -// Changed procedure AddMaskOnly so that it doesn't leak a GDI HBitmap-object // -// and it doesn't release the handle of the source bitmap which // -// is used to assign to the GIF object as in gif.assign(bm); // -// These changes were made as a result of a news post made by Renate Schaaf // -// with the subject "TGifImage HBitmap leak on assign?" // -// in borland.public.delphi.graphics on Mon 28 Jul 2003 and Sun 03 Aug 2003. // -// // -// Changed 2004.03.09 by Finn Tolderlund: // -// Added a ForceFrame property to the TGIFImage class. // -// The ForceFrame property can be used to make TGIFImage display a apecific // -// sub frame from an animated gif. // -// How to use: Set the Animate property to False and set the ForceFrame // -// property to a desired frame number (0-N) // -// Normal display: Set the ForceFrame property to -1 and set Animate to True. // -// If ForceFrame is negative TGIFImage behaves just as before this change. // -// Note that if the sub frame in the gif only contains part of the image // -// (i.e. only the changes from previous frames) the result is unpredictable. // -// The result is best if each sub frame contains a whole image. // -// If the sub frame is transparent the background is not automatically // -// restored, you must do so yourself if you want that. // -// If you are using a TImage to display the gif you can use // -// Image.Parent.Invalidate or Image.Parent.Refresh to restore the background. // -// This change was made as a result of a email correspondance with // -// Tineke Kosmis (http://www.classe.nl/) which requested such a property. // -// // -// Changed 2006.07.09 by Finn Tolderlund: // -// Added conditional switch as default: FIXHEADER_WIDTHHEIGHT_SILENT // -// When the switch is defined: // -// When loading a gif all frames are examined. If a frame has a larger // -// Width/Height than the header values then the header values are updated // -// with the larger values from the frame. // -// I had a MANTA.GIF where the header said 120x89 but the frames said 200x148 // -// and the frames got clipped. MSIE didn't clip it. // -// http://www.graphcomp.com/info/specs/ani_gif.html : // -// Do not assume all of your images are the same size. Read through their // -// sizes and set the logical screen to the largest width & height included // -// in the file. // -// By removing the define FIXHEADER_WIDTHHEIGHT_SILENT // -// the header is not altered. This makes the unit work as before. // -// // -// Changed 2006.07.10 by Finn Tolderlund: // -// Added conditional switch as default: DEFAULT_GOCLEARLOOP // -// When the switch is defined: // -// When loading a gif default DrawOptions include goClearLoop // -// Same as adding goClearLoop manually to DrawOptions. // -// This will clear an animated gif before first frame on each loop. // -// Someone sent me a 'conductor.gif' where some of the last frame was retaind // -// when beginning a new loop and that was visually incorrect. // -// Without glClearLoop the first frame may look different on the second loop // -// because some part of the last frame could still be present. // -// With goClearLoop the first frame will always look the same on each loop. // -// I think the last is better. // -// // -// Changed 2006.07.29 by Finn Tolderlund: // -// Added a check in procedure TGIFSubImage.Decompress to make sure that // -// the InitialBitsPerCode variable never exeeds the value 15. // -// Someone sent an animated iup110296.gif (corrupt I think) which caused // -// this unit to crash in function NextLZW because InitialBitsPerCode was 20. // -// This fix prevents the crash and should not cause problems with other gifs. // -// Not sure that the fix is the correct way to handle it. It seems to work. // -// // -// Changed 2006.10.09 by Finn Tolderlund: // -// Received a mail from Michael Thomas Greer with a fix that allows // -// the TGIFSubImage.Pixels[] property to be writeable. The help file states // -// that the Pixels property can be written, but it was read-only. // -// Help file: "Write Pixels to change the color index of individual pixels". // -// // -// Changed 2006.10.16 by Finn Tolderlund: // -// Received a mail from Maurizio Lotauro who was using Delphi 5 and FastMM4. // -// FastMM4 complains about a memory leak when using Delphi 5. // -// I don't have Delphi 5 installed so I can't test if there really is a // -// memory leak or if it's just FastMM4 which can't detect it correctly. // -// The problem and fix only applies to Delphi 5 or older. // -// Added a fix to keep FastMM4 happy. See more at this link: // -// http://sourceforge.net/forum/forum.php?thread_id=1559584&forum_id=443400 // -// // -// Changed 2007.01.18 by Finn Tolderlund: // -// The ReduceColors function is changed so that it's now possible to use // -// the TFastColorLookup class if you use ColorReduction rmQuantize. // -// The TFastColorLookup class was removed 2003-03-06, but is introduced again // -// because Paul Lopez needed speed when adding images to a gif. // -// This changes how rmQuantize works: It's now fast but less precise. // -// This means: // -// Use rmQuantizeWindows to get precision, use rmQuantize if you need speed. // -// // -// Changed 2008.10.19 by Finn Tolderlund: // -// Now compatible with Delphi 2009. // -// Generally changed use of Char/PChar to AnsiChar/PAnsiChar. // -// // -// Changed 2009.10.10 by Finn Tolderlund: // -// Now compatible with Delphi 2010. // -// Changed conditional defines to assume Delphi 2010 for future compilers. // -// Kind thanks to Peter Johnson (www.delphidabbler.com) // -// // -// Changed 2009.10.14 by Finn Tolderlund: // -// Simplified the list of defines and remove a few warnings in Delphi 2006. // -// // -// Changed 2009.10.24 by Peter Johnson (delphidabbler) // -// Switched explicit string cast with loss warning for Delphi 2009 and later. // -// // -// Changed 2010.03.18 by Peter Johnson (delphidabbler) // -// Comment out all TODOs. // -// // -//////////////////////////////////////////////////////////////////////////////// -// // -// Please read the "Conditions of use" in the release notes. // -// // -//////////////////////////////////////////////////////////////////////////////// -// Known problems: -// -// * The combination of buffered, tiled and transparent draw will display the -// background incorrectly (scaled). -// If this is a problem for you, use non-buffered (goDirectDraw) drawing -// instead. -// -// * The combination of non-buffered, transparent and stretched draw is -// sometimes distorted with a pattern effect when the image is displayed -// smaller than the real size (shrinked). -// -// * Buffered display flickers when TGIFImage is used by a transparent TImage -// component. -// This is a problem with TImage caused by the fact that TImage was designed -// with static images in mind. Not much I can do about it. -// -//////////////////////////////////////////////////////////////////////////////// -// To do (in rough order of priority): -// {.TODO -oanme -cFeature : TImage hook for destroy notification. } -// {.TODO -oanme -cFeature : TBitmap pool to limit resource consumption on Win95/98. } -// {.TODO -oanme -cImprovement : Make BitsPerPixel property writable. } -// {.TODO -oanme -cFeature : Visual GIF component. } -// {.TODO -oanme -cImprovement : Easier method to determine DrawPainter status. } -// {.TODO -oanme -cFeature : Import to 256+ color GIF. } -// {.TODO -oanme -cFeature : Make some of TGIFImage's properties persistent (DrawOptions etc). } -// {.TODO -oanme -cFeature : Add TGIFImage.Persistent property. Should save published properties in application extension when this options is set. } -// {.TODO -oanme -cBugFix : Solution for background buffering in scrollbox. } -// -////////////////////////////////////////////////////////////////////////////////// -{$ifdef BCB} -{$ObjExportAll On} -{$endif} - -interface -//////////////////////////////////////////////////////////////////////////////// -// -// Conditional Compiler Symbols -// -//////////////////////////////////////////////////////////////////////////////// -(* - DEBUG Must be defined if any of the DEBUG_xxx - symbols are defined. - If the symbol is defined the source will not be - optimized and overflow- and range checks will be - enabled. - - DEBUG_HASHPERFORMANCE Calculates hash table performance data. - DEBUG_HASHFILLFACTOR Calculates fill factor of hash table - - Interferes with DEBUG_HASHPERFORMANCE. - DEBUG_COMPRESSPERFORMANCE Calculates LZW compressor performance data. - DEBUG_DECOMPRESSPERFORMANCE Calculates LZW decompressor performance data. - DEBUG_DITHERPERFORMANCE Calculates color reduction performance data. - DEBUG_DRAWPERFORMANCE Calculates low level drawing performance data. - The performance data for DEBUG_DRAWPERFORMANCE - will be displayed when you press the Ctrl key. - DEBUG_RENDERPERFORMANCE Calculates performance data for the GIF to - bitmap converter. - The performance data for DEBUG_DRAWPERFORMANCE - will be displayed when you press the Ctrl key. - - GIF_NOSAFETY Define this symbol to disable overflow- and - range checks. - Ignored if the DEBUG symbol is defined. - - STRICT_MOZILLA Define to mimic Mozilla as closely as possible. - If not defined, a slightly more "optimal" - implementation is used (IMHO). - - FAST_AS_HELL Define this symbol to use strictly GIF compliant - (but too fast) animation timing. - Since our paint routines are much faster and - more precise timed than Mozilla's, the standard - GIF and Mozilla values causes animations to loop - faster than they would in Mozilla. - If the symbol is _not_ defined, an alternative - set of tweaked timing values will be used. - The tweaked values are not optimal but are based - on tests performed on my reference system: - - Windows 95 - - 133 MHz Pentium - - 64Mb RAM - - Diamond Stealth64/V3000 - - 1600*1200 in 256 colors - The alternate values can be modified if you are - not satisfied with my defaults (they can be - found a few pages down). - - REGISTER_TGIFIMAGE Define this symbol to register TGIFImage with - the TPicture class and integrate with TImage. - This is required to be able to display GIFs in - the TImage component. - The symbol is defined by default. - Undefine if you use another GIF library to - provide GIF support for TImage. - - PIXELFORMAT_TOO_SLOW When this symbol is defined, the internal - PixelFormat routines are used in some places - instead of TBitmap.PixelFormat. - The current implementation (Delphi4, Builder 3) - of TBitmap.PixelFormat can in some situation - degrade performance. - The symbol is defined by default. - - CREATEDIBSECTION_SLOW If this symbol is defined, TDIBWriter will - use global memory as scanline storage, instead - of a DIB section. - Benchmarks have shown that a DIB section is - twice as slow as global memory. - The symbol is defined by default. - The symbol requires that PIXELFORMAT_TOO_SLOW - is defined. - - SERIALIZE_RENDER Define this symbol to serialize threaded - GIF to bitmap rendering. - When a GIF is displayed with the goAsync option - (the default), the GIF to bitmap rendering is - executed in the context of the draw thread. - If more than one thread is drawing the same GIF - or the GIF is being modified while it is - animating, the GIF to bitmap rendering should be - serialized to guarantee that the bitmap isn't - modified by more than one thread at a time. If - SERIALIZE_RENDER is defined, the draw threads - uses TThread.Synchronize to serialize GIF to - bitmap rendering. - - FIXHEADER_WIDTHHEIGHT_SILENT Define this symbol to adjust Width and Height - in the header if any of the frames has a larger - Width or Height. - - DEFAULT_GOCLEARLOOP Define this symbol to clear animation on each - loop before first frame. - Same as adding goClearLoop to DrawOptions. - STRICT_MOZILLA does the same, - but STRICT_MOZILLA does something more. - -*) - -{$DEFINE REGISTER_TGIFIMAGE} -{$DEFINE PIXELFORMAT_TOO_SLOW} -{$DEFINE CREATEDIBSECTION_SLOW} -{$DEFINE FIXHEADER_WIDTHHEIGHT_SILENT} -{$DEFINE DEFAULT_GOCLEARLOOP} - -//////////////////////////////////////////////////////////////////////////////// -// -// Determine Delphi and C++ Builder version -// -//////////////////////////////////////////////////////////////////////////////// - -// Delphi 1.x -{$IFDEF VER80} - 'Error: TGIFImage does not support Delphi 1.x' -{$ENDIF} - -// Delphi 2.x -{$IFDEF VER90} - {$DEFINE VER9x} -{$ENDIF} - -// C++ Builder 1.x -{$IFDEF VER93} - // Good luck... - {$DEFINE VER9x} -{$ENDIF} - -// Delphi 3.x -{$IFDEF VER100} - {$DEFINE VER10_PLUS} - {$DEFINE D3_BCB3} -{$ENDIF} - -// C++ Builder 3.x -{$IFDEF VER110} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE D3_BCB3} - {$DEFINE BAD_STACK_ALIGNMENT} -{$ENDIF} - -// Delphi 4.x -{$IFDEF VER120} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} -{$ENDIF} - -// C++ Builder 4.x -{$IFDEF VER125} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE VER125_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} -{$ENDIF} - -// Delphi 5.x -{$IFDEF VER130} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE VER125_PLUS} - {$DEFINE VER13_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} -{$ENDIF} - -(* -// Delphi 6.x -{$IFDEF VER140} - {$WARN SYMBOL_PLATFORM OFF} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE VER125_PLUS} - {$DEFINE VER13_PLUS} - {$DEFINE VER14_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} -{$ENDIF} - -// Delphi 7.x -{$IFDEF VER150} - {$WARN SYMBOL_PLATFORM OFF} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE VER125_PLUS} - {$DEFINE VER13_PLUS} - {$DEFINE VER14_PLUS} - {$DEFINE VER15_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} -{$ENDIF} - -// 2008.10.19 -> -// Delphi 2009 -{$IFDEF VER200} - {$WARN SYMBOL_PLATFORM OFF} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE VER125_PLUS} - {$DEFINE VER13_PLUS} - {$DEFINE VER14_PLUS} - {$DEFINE VER15_PLUS} - {$DEFINE VER20_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} -{$ENDIF} -// 2008.10.19 <- - -// 2003.03.09 -> -// Unknown compiler version - assume D7 compatible -{$IFNDEF VER9x} -{$IFNDEF VER10_PLUS} - {$WARN SYMBOL_PLATFORM OFF} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE VER125_PLUS} - {$DEFINE VER13_PLUS} - {$DEFINE VER14_PLUS} - {$DEFINE VER15_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} -{$ENDIF} -{$ENDIF} -// 2003.03.09 <- - -// 2009.10.10 -> -// This ensures that future compilers always have same defines as latest compiler listed here. -{$IFDEF CONDITIONALEXPRESSIONS} - {$IF CompilerVersion >= 21.0} // >= Delphi 2010 - {$WARN SYMBOL_PLATFORM OFF} - {$WARN SYMBOL_DEPRECATED OFF} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE VER125_PLUS} - {$DEFINE VER13_PLUS} - {$DEFINE VER14_PLUS} - {$DEFINE VER15_PLUS} - {$DEFINE VER20_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} - {$DEFINE VER21_PLUS} - {$IFEND} -{$ENDIF} -// 2009.10.10 <- -*) - -// 2009.10.14 -> -// This ensures that future compilers always have same defines as latest compiler listed here. -{$IFDEF CONDITIONALEXPRESSIONS} - {$IF CompilerVersion >= 14.0} // >= Delphi 6 - {$WARN SYMBOL_PLATFORM OFF} - {$WARN SYMBOL_DEPRECATED OFF} - {$DEFINE VER10_PLUS} - {$DEFINE VER11_PLUS} - {$DEFINE VER12_PLUS} - {$DEFINE VER125_PLUS} - {$DEFINE VER13_PLUS} - {$DEFINE VER14_PLUS} - {$DEFINE BAD_STACK_ALIGNMENT} - {$IFEND} - {$IF CompilerVersion >= 15.0} // >= Delphi 7 - {$DEFINE VER15_PLUS} - {$IFEND} - {$IF CompilerVersion >= 20.0} // >= Delphi 2009 - {$DEFINE VER20_PLUS} - // 2009.10.24 delphidabbler -> - {$WARN EXPLICIT_STRING_CAST_LOSS OFF} - // 2009.10.24 delphidabbler <- - {$IFEND} - {$IF CompilerVersion >= 21.0} // >= Delphi 2010 - {$DEFINE VER21_PLUS} - {$IFEND} -{$ENDIF} -// 2009.10.14 <- - -//////////////////////////////////////////////////////////////////////////////// -// -// Compiler Options required to compile this library -// -//////////////////////////////////////////////////////////////////////////////// -{$A+,B-,H+,J+,K-,M-,T-,X+} - -// Debug control - You can safely change these settings -{$IFDEF DEBUG} - {$C+} // ASSERTIONS - {$O-} // OPTIMIZATION - {$Q+} // OVERFLOWCHECKS - {$R+} // RANGECHECKS -{$ELSE} - {$C-} // ASSERTIONS - {$IFDEF GIF_NOSAFETY} - {$Q-}// OVERFLOWCHECKS - {$R-}// RANGECHECKS - {$ENDIF} -{$ENDIF} - -// Special options for Time2Help parser -{$ifdef TIME2HELP} -{$UNDEF PIXELFORMAT_TOO_SLOW} -{$endif} - -//////////////////////////////////////////////////////////////////////////////// -// -// External dependecies -// -//////////////////////////////////////////////////////////////////////////////// -uses - sysutils, - Windows, - Graphics, - Classes; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFImage library version -// -//////////////////////////////////////////////////////////////////////////////// -const - GIFVersion = $0202; - GIFVersionMajor = 2; - GIFVersionMinor = 2; - GIFVersionRelease = 5; - -//////////////////////////////////////////////////////////////////////////////// -// -// Misc constants and support types -// -//////////////////////////////////////////////////////////////////////////////// -const - GIFMaxColors = 256; // Max number of colors supported by GIF - // Don't bother changing this value! - - BitmapAllocationThreshold = 500000; // Bitmap pixel count limit at which - // a newly allocated bitmap will be - // converted to 1 bit format before - // being resized and converted to 8 bit. - -var -{$IFDEF FAST_AS_HELL} - GIFDelayExp: integer = 10; // Delay multiplier in mS. -{$ELSE} - GIFDelayExp: integer = 12; // Delay multiplier in mS. Tweaked. -{$ENDIF} - // * GIFDelayExp: - // The following delay values should all - // be multiplied by this value to - // calculate the effective time (in mS). - // According to the GIF specs, this - // value should be 10. - // Since our paint routines are much - // faster than Mozilla's, you might need - // to increase this value if your - // animations loops too fast. The - // optimal value is impossible to - // determine since it depends on the - // speed of the CPU, the viceo card, - // memory and many other factors. - - GIFDefaultDelay: integer = 10; // * GIFDefaultDelay: - // Default animation delay. - // This value is used if no GCE is - // defined. - // (10 = 100 mS) - -{$IFDEF FAST_AS_HELL} - GIFMinimumDelay: integer = 1; // Minimum delay (from Mozilla source). - // (1 = 10 mS) -{$ELSE} - GIFMinimumDelay: integer = 3; // Minimum delay - Tweaked. -{$ENDIF} - // * GIFMinimumDelay: - // The minumum delay used in the Mozilla - // source is 10mS. This corresponds to a - // value of 1. However, since our paint - // routines are much faster than - // Mozilla's, a value of 3 or 4 gives - // better results. - - GIFMaximumDelay: integer = 1000; // * GIFMaximumDelay: - // Maximum delay when painter is running - // in main thread (goAsync is not set). - // This value guarantees that a very - // long and slow GIF does not hang the - // system. - // (1000 = 10000 mS = 10 Seconds) - -type - TGIFVersion = (gvUnknown, gv87a, gv89a); - TGIFVersionRec = array[0..2] of AnsiChar; - -const - GIFVersions : array[gv87a..gv89a] of TGIFVersionRec = ('87a', '89a'); - -type - // TGIFImage mostly throws exceptions of type GIFException - GIFException = class(EInvalidGraphic); - - // Severity level as indicated in the Warning methods and the OnWarning event - TGIFSeverity = (gsInfo, gsWarning, gsError); - -//////////////////////////////////////////////////////////////////////////////// -// -// Delphi 2.x support -// -//////////////////////////////////////////////////////////////////////////////// -{$IFDEF VER9x} -// Delphi 2 doesn't support TBitmap.PixelFormat -{$DEFINE PIXELFORMAT_TOO_SLOW} -type - // TThreadList from Delphi 3 classes.pas - TThreadList = class - private - FList: TList; - FLock: TRTLCriticalSection; - public - constructor Create; - destructor Destroy; override; - procedure Add(Item: Pointer); - procedure Clear; - function LockList: TList; - procedure Remove(Item: Pointer); - procedure UnlockList; - end; - - // From Delphi 3 sysutils.pas - EOutOfMemory = class(Exception); - - // From Delphi 3 classes.pas - EOutOfResources = class(EOutOfMemory); - - // From Delphi 3 windows.pas - PMaxLogPalette = ^TMaxLogPalette; - TMaxLogPalette = packed record - palVersion: Word; - palNumEntries: Word; - palPalEntry: array [Byte] of TPaletteEntry; - end; { TMaxLogPalette } - - // From Delphi 3 graphics.pas. Used by the D3 TGraphic class. - TProgressStage = (psStarting, psRunning, psEnding); - TProgressEvent = procedure (Sender: TObject; Stage: TProgressStage; - PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string) of object; - - // From Delphi 3 windows.pas - PRGBTriple = ^TRGBTriple; -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// -// Forward declarations -// -//////////////////////////////////////////////////////////////////////////////// -type - TGIFImage = class; - TGIFSubImage = class; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFItem -// -//////////////////////////////////////////////////////////////////////////////// - TGIFItem = class(TPersistent) - private - FGIFImage: TGIFImage; - protected - function GetVersion: TGIFVersion; virtual; - procedure Warning(Severity: TGIFSeverity; Message: string); virtual; - public - constructor Create(GIFImage: TGIFImage); virtual; - - procedure SaveToStream(Stream: TStream); virtual; abstract; - procedure LoadFromStream(Stream: TStream); virtual; abstract; - procedure SaveToFile(const Filename: string); virtual; - procedure LoadFromFile(const Filename: string); virtual; - property Version: TGIFVersion read GetVersion; - property Image: TGIFImage read FGIFImage; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFList -// -//////////////////////////////////////////////////////////////////////////////// - TGIFList = class(TPersistent) - private - FItems: TList; - FImage: TGIFImage; - protected - function GetItem(Index: Integer): TGIFItem; - procedure SetItem(Index: Integer; Item: TGIFItem); - function GetCount: Integer; - procedure Warning(Severity: TGIFSeverity; Message: string); virtual; - public - constructor Create(Image: TGIFImage); - destructor Destroy; override; - - function Add(Item: TGIFItem): Integer; - procedure Clear; - procedure Delete(Index: Integer); - procedure Exchange(Index1, Index2: Integer); - function First: TGIFItem; - function IndexOf(Item: TGIFItem): Integer; - procedure Insert(Index: Integer; Item: TGIFItem); - function Last: TGIFItem; - procedure Move(CurIndex, NewIndex: Integer); - function Remove(Item: TGIFItem): Integer; - procedure SaveToStream(Stream: TStream); virtual; - procedure LoadFromStream(Stream: TStream; Parent: TObject); virtual; abstract; - - property Items[Index: Integer]: TGIFItem read GetItem write SetItem; default; - property Count: Integer read GetCount; - property List: TList read FItems; - property Image: TGIFImage read FImage; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFColorMap -// -//////////////////////////////////////////////////////////////////////////////// - // One way to do it: - // TBaseColor = (bcRed, bcGreen, bcBlue); - // TGIFColor = array[bcRed..bcBlue] of BYTE; - // Another way: - TGIFColor = packed record - Red: byte; - Green: byte; - Blue: byte; - end; - - TColorMap = packed array[0..GIFMaxColors-1] of TGIFColor; - PColorMap = ^TColorMap; - - TUsageCount = record - Count : integer; // # of pixels using color index - Index : integer; // Color index - end; - TColormapHistogram = array[0..255] of TUsageCount; - TColormapReverse = array[0..255] of byte; - - TGIFColorMap = class(TPersistent) - private - FColorMap : PColorMap; - FCount : integer; - FCapacity : integer; - FOptimized : boolean; - protected - function GetColor(Index: integer): TColor; - procedure SetColor(Index: integer; Value: TColor); - function GetBitsPerPixel: integer; - function DoOptimize: boolean; - procedure SetCapacity(Size: integer); - procedure Warning(Severity: TGIFSeverity; Message: string); virtual; abstract; - procedure BuildHistogram(var Histogram: TColormapHistogram); virtual; abstract; - procedure MapImages(var Map: TColormapReverse); virtual; abstract; - - public - constructor Create; - destructor Destroy; override; - class function Color2RGB(Color: TColor): TGIFColor; - class function RGB2Color(Color: TGIFColor): TColor; - procedure SaveToStream(Stream: TStream); - procedure LoadFromStream(Stream: TStream; Count: integer); - procedure Assign(Source: TPersistent); override; - function IndexOf(Color: TColor): integer; - function Add(Color: TColor): integer; - function AddUnique(Color: TColor): integer; - procedure Delete(Index: integer); - procedure Clear; - function Optimize: boolean; virtual; abstract; - procedure Changed; virtual; abstract; - procedure ImportPalette(Palette: HPalette); - procedure ImportColorTable(Pal: pointer; Count: integer); - procedure ImportDIBColors(Handle: HDC); - procedure ImportColorMap(Map: TColorMap; Count: integer); - function ExportPalette: HPalette; - property Colors[Index: integer]: TColor read GetColor write SetColor; default; - property Data: PColorMap read FColorMap; - property Count: integer read FCount; - property Optimized: boolean read FOptimized write FOptimized; - property BitsPerPixel: integer read GetBitsPerPixel; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFHeader -// -//////////////////////////////////////////////////////////////////////////////// - TLogicalScreenDescriptor = packed record - ScreenWidth: word; { logical screen width } - ScreenHeight: word; { logical screen height } - PackedFields: byte; { packed fields } - BackgroundColorIndex: byte; { index to global color table } - AspectRatio: byte; { actual ratio = (AspectRatio + 15) / 64 } - end; - - TGIFHeader = class(TGIFItem) - private - FLogicalScreenDescriptor: TLogicalScreenDescriptor; - FColorMap : TGIFColorMap; - procedure Prepare; - protected - function GetVersion: TGIFVersion; override; - function GetBackgroundColor: TColor; - procedure SetBackgroundColor(Color: TColor); - procedure SetBackgroundColorIndex(Index: BYTE); - function GetBitsPerPixel: integer; - function GetColorResolution: integer; - public - constructor Create(GIFImage: TGIFImage); override; - destructor Destroy; override; - procedure Assign(Source: TPersistent); override; - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - procedure Clear; - property Version: TGIFVersion read GetVersion; - property Width: WORD read FLogicalScreenDescriptor.ScreenWidth - write FLogicalScreenDescriptor.ScreenWidth; - property Height: WORD read FLogicalScreenDescriptor.ScreenHeight - write FLogicalScreenDescriptor.Screenheight; - property BackgroundColorIndex: BYTE read FLogicalScreenDescriptor.BackgroundColorIndex - write SetBackgroundColorIndex; - property BackgroundColor: TColor read GetBackgroundColor - write SetBackgroundColor; - property AspectRatio: BYTE read FLogicalScreenDescriptor.AspectRatio - write FLogicalScreenDescriptor.AspectRatio; - property ColorMap: TGIFColorMap read FColorMap; - property BitsPerPixel: integer read GetBitsPerPixel; - property ColorResolution: integer read GetColorResolution; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFExtension -// -//////////////////////////////////////////////////////////////////////////////// - TGIFExtensionType = BYTE; - TGIFExtension = class; - TGIFExtensionClass = class of TGIFExtension; - - TGIFGraphicControlExtension = class; - - TGIFExtension = class(TGIFItem) - private - FSubImage: TGIFSubImage; - protected - function GetExtensionType: TGIFExtensionType; virtual; abstract; - function GetVersion: TGIFVersion; override; - function DoReadFromStream(Stream: TStream): TGIFExtensionType; - class procedure RegisterExtension(elabel: BYTE; eClass: TGIFExtensionClass); - class function FindExtension(Stream: TStream): TGIFExtensionClass; - class function FindSubExtension(Stream: TStream): TGIFExtensionClass; virtual; - public - // Ignore compiler warning about hiding base class constructor - constructor Create(ASubImage: TGIFSubImage); {$IFDEF VER12_PLUS} reintroduce; {$ENDIF} virtual; - destructor Destroy; override; - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - property ExtensionType: TGIFExtensionType read GetExtensionType; - property SubImage: TGIFSubImage read FSubImage; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFSubImage -// -//////////////////////////////////////////////////////////////////////////////// - TGIFExtensionList = class(TGIFList) - protected - function GetExtension(Index: Integer): TGIFExtension; - procedure SetExtension(Index: Integer; Extension: TGIFExtension); - public - procedure LoadFromStream(Stream: TStream; Parent: TObject); override; - property Extensions[Index: Integer]: TGIFExtension read GetExtension write SetExtension; default; - end; - - TImageDescriptor = packed record - Separator: byte; { fixed value of ImageSeparator } - Left: word; { Column in pixels in respect to left edge of logical screen } - Top: word; { row in pixels in respect to top of logical screen } - Width: word; { width of image in pixels } - Height: word; { height of image in pixels } - PackedFields: byte; { Bit fields } - end; - - TGIFSubImage = class(TGIFItem) - private - FBitmap : TBitmap; - FMask : HBitmap; - FNeedMask : boolean; - FLocalPalette : HPalette; - FData : PAnsiChar; - FDataSize : integer; - FColorMap : TGIFColorMap; - FImageDescriptor : TImageDescriptor; - FExtensions : TGIFExtensionList; - FTransparent : boolean; - FGCE : TGIFGraphicControlExtension; - procedure Prepare; - procedure Compress(Stream: TStream); - procedure Decompress(Stream: TStream); - protected - function GetVersion: TGIFVersion; override; - function GetInterlaced: boolean; - procedure SetInterlaced(Value: boolean); - function GetColorResolution: integer; - function GetBitsPerPixel: integer; - procedure AssignTo(Dest: TPersistent); override; - function DoGetBitmap: TBitmap; - function DoGetDitherBitmap: TBitmap; - function GetBitmap: TBitmap; - procedure SetBitmap(Value: TBitmap); - procedure FreeMask; - function GetEmpty: Boolean; - function GetPalette: HPALETTE; - procedure SetPalette(Value: HPalette); - function GetActiveColorMap: TGIFColorMap; - function GetBoundsRect: TRect; - procedure SetBoundsRect(const Value: TRect); - procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); - function GetClientRect: TRect; - function GetPixel(x, y: integer): BYTE; -// 2006.10.09 -> - procedure SetPixel(x, y: integer; Value: BYTE); -// 2006.10.09 <- - function GetScanline(y: integer): pointer; - procedure NewBitmap; - procedure FreeBitmap; - procedure NewImage; - procedure FreeImage; - procedure NeedImage; - function ScaleRect(DestRect: TRect): TRect; - function HasMask: boolean; - function GetBounds(Index: integer): WORD; - procedure SetBounds(Index: integer; Value: WORD); - function GetHasBitmap: boolean; - procedure SetHasBitmap(Value: boolean); - public - constructor Create(GIFImage: TGIFImage); override; - destructor Destroy; override; - procedure Clear; - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - procedure Assign(Source: TPersistent); override; - procedure Draw(ACanvas: TCanvas; const Rect: TRect; - DoTransparent, DoTile: boolean); - procedure StretchDraw(ACanvas: TCanvas; const Rect: TRect; - DoTransparent, DoTile: boolean); - procedure Crop; - procedure Merge(Previous: TGIFSubImage); - property HasBitmap: boolean read GetHasBitmap write SetHasBitmap; - property Left: WORD index 1 read GetBounds write SetBounds; - property Top: WORD index 2 read GetBounds write SetBounds; - property Width: WORD index 3 read GetBounds write SetBounds; - property Height: WORD index 4 read GetBounds write SetBounds; - property BoundsRect: TRect read GetBoundsRect write SetBoundsRect; - property ClientRect: TRect read GetClientRect; - property Interlaced: boolean read GetInterlaced write SetInterlaced; - property ColorMap: TGIFColorMap read FColorMap; - property ActiveColorMap: TGIFColorMap read GetActiveColorMap; - property Data: PAnsiChar read FData; - property DataSize: integer read FDataSize; - property Extensions: TGIFExtensionList read FExtensions; - property Version: TGIFVersion read GetVersion; - property ColorResolution: integer read GetColorResolution; - property BitsPerPixel: integer read GetBitsPerPixel; - property Bitmap: TBitmap read GetBitmap write SetBitmap; - property Mask: HBitmap read FMask; - property Palette: HPALETTE read GetPalette write SetPalette; - property Empty: boolean read GetEmpty; - property Transparent: boolean read FTransparent; - property GraphicControlExtension: TGIFGraphicControlExtension read FGCE; -// 2006.10.09 -> -// property Pixels[x, y: integer]: BYTE read GetPixel; - property Pixels[x, y: integer]: BYTE read GetPixel write SetPixel; -// 2006.10.09 <- - property Scanline[y: integer]: pointer read GetScanline; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFTrailer -// -//////////////////////////////////////////////////////////////////////////////// - TGIFTrailer = class(TGIFItem) - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFGraphicControlExtension -// -//////////////////////////////////////////////////////////////////////////////// - // Graphic Control Extension block a.k.a GCE - TGIFGCERec = packed record - BlockSize: byte; { should be 4 } - PackedFields: Byte; - DelayTime: Word; { in centiseconds } - TransparentColorIndex: Byte; - Terminator: Byte; - end; - - TDisposalMethod = (dmNone, dmNoDisposal, dmBackground, dmPrevious); - - TGIFGraphicControlExtension = class(TGIFExtension) - private - FGCExtension: TGIFGCERec; - protected - function GetExtensionType: TGIFExtensionType; override; - function GetTransparent: boolean; - procedure SetTransparent(Value: boolean); - function GetTransparentColor: TColor; - procedure SetTransparentColor(Color: TColor); - function GetTransparentColorIndex: BYTE; - procedure SetTransparentColorIndex(Value: BYTE); - function GetDelay: WORD; - procedure SetDelay(Value: WORD); - function GetUserInput: boolean; - procedure SetUserInput(Value: boolean); - function GetDisposal: TDisposalMethod; - procedure SetDisposal(Value: TDisposalMethod); - - public - constructor Create(ASubImage: TGIFSubImage); override; - destructor Destroy; override; - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - property Delay: WORD read GetDelay write SetDelay; - property Transparent: boolean read GetTransparent write SetTransparent; - property TransparentColorIndex: BYTE read GetTransparentColorIndex - write SetTransparentColorIndex; - property TransparentColor: TColor read GetTransparentColor write SetTransparentColor; - property UserInput: boolean read GetUserInput write SetUserInput; - property Disposal: TDisposalMethod read GetDisposal write SetDisposal; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFTextExtension -// -//////////////////////////////////////////////////////////////////////////////// - TGIFPlainTextExtensionRec = packed record - BlockSize: byte; { should be 12 } - Left, Top, Width, Height: Word; - CellWidth, CellHeight: Byte; - TextFGColorIndex, - TextBGColorIndex: Byte; - end; - - TGIFTextExtension = class(TGIFExtension) - private - FText : TStrings; - FPlainTextExtension : TGIFPlainTextExtensionRec; - protected - function GetExtensionType: TGIFExtensionType; override; - function GetForegroundColor: TColor; - procedure SetForegroundColor(Color: TColor); - function GetBackgroundColor: TColor; - procedure SetBackgroundColor(Color: TColor); - function GetBounds(Index: integer): WORD; - procedure SetBounds(Index: integer; Value: WORD); - function GetCharWidthHeight(Index: integer): BYTE; - procedure SetCharWidthHeight(Index: integer; Value: BYTE); - function GetColorIndex(Index: integer): BYTE; - procedure SetColorIndex(Index: integer; Value: BYTE); - public - constructor Create(ASubImage: TGIFSubImage); override; - destructor Destroy; override; - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - property Left: WORD index 1 read GetBounds write SetBounds; - property Top: WORD index 2 read GetBounds write SetBounds; - property GridWidth: WORD index 3 read GetBounds write SetBounds; - property GridHeight: WORD index 4 read GetBounds write SetBounds; - property CharWidth: BYTE index 1 read GetCharWidthHeight write SetCharWidthHeight; - property CharHeight: BYTE index 2 read GetCharWidthHeight write SetCharWidthHeight; - property ForegroundColorIndex: BYTE index 1 read GetColorIndex write SetColorIndex; - property ForegroundColor: TColor read GetForegroundColor; - property BackgroundColorIndex: BYTE index 2 read GetColorIndex write SetColorIndex; - property BackgroundColor: TColor read GetBackgroundColor; - property Text: TStrings read FText write FText; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFCommentExtension -// -//////////////////////////////////////////////////////////////////////////////// - TGIFCommentExtension = class(TGIFExtension) - private - FText : TStrings; - protected - function GetExtensionType: TGIFExtensionType; override; - public - constructor Create(ASubImage: TGIFSubImage); override; - destructor Destroy; override; - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - property Text: TStrings read FText; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFApplicationExtension -// -//////////////////////////////////////////////////////////////////////////////// - TGIFIdentifierCode = array[0..7] of AnsiChar; - TGIFAuthenticationCode = array[0..2] of AnsiChar; - TGIFApplicationRec = packed record - Identifier : TGIFIdentifierCode; - Authentication : TGIFAuthenticationCode; - end; - - TGIFApplicationExtension = class; - TGIFAppExtensionClass = class of TGIFApplicationExtension; - - TGIFApplicationExtension = class(TGIFExtension) - private - FIdent : TGIFApplicationRec; - function GetAuthentication: AnsiString; - function GetIdentifier: AnsiString; - protected - function GetExtensionType: TGIFExtensionType; override; - procedure SetAuthentication(const Value: AnsiString); - procedure SetIdentifier(const Value: AnsiString); - procedure SaveData(Stream: TStream); virtual; abstract; - procedure LoadData(Stream: TStream); virtual; abstract; - public - constructor Create(ASubImage: TGIFSubImage); override; - destructor Destroy; override; - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - class procedure RegisterExtension(eIdent: TGIFApplicationRec; eClass: TGIFAppExtensionClass); - class function FindSubExtension(Stream: TStream): TGIFExtensionClass; override; - property Identifier: AnsiString read GetIdentifier write SetIdentifier; - property Authentication: AnsiString read GetAuthentication write SetAuthentication; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFUnknownAppExtension -// -//////////////////////////////////////////////////////////////////////////////// - TGIFBlock = class(TObject) - private - FSize : BYTE; - FData : pointer; - public - constructor Create(ASize: integer); - destructor Destroy; override; - procedure SaveToStream(Stream: TStream); - procedure LoadFromStream(Stream: TStream); - property Size: BYTE read FSize; - property Data: pointer read FData; - end; - - TGIFUnknownAppExtension = class(TGIFApplicationExtension) - private - FBlocks : TList; - protected - procedure SaveData(Stream: TStream); override; - procedure LoadData(Stream: TStream); override; - public - constructor Create(ASubImage: TGIFSubImage); override; - destructor Destroy; override; - property Blocks: TList read FBlocks; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFAppExtNSLoop -// -//////////////////////////////////////////////////////////////////////////////// - TGIFAppExtNSLoop = class(TGIFApplicationExtension) - private - FLoops : WORD; - FBufferSize : DWORD; - protected - procedure SaveData(Stream: TStream); override; - procedure LoadData(Stream: TStream); override; - public - constructor Create(ASubImage: TGIFSubImage); override; - property Loops: WORD read FLoops write FLoops; - property BufferSize: DWORD read FBufferSize write FBufferSize; - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFImage -// -//////////////////////////////////////////////////////////////////////////////// - TGIFImageList = class(TGIFList) - protected - function GetImage(Index: Integer): TGIFSubImage; - procedure SetImage(Index: Integer; SubImage: TGIFSubImage); - public - procedure LoadFromStream(Stream: TStream; Parent: TObject); override; - procedure SaveToStream(Stream: TStream); override; - property SubImages[Index: Integer]: TGIFSubImage read GetImage write SetImage; default; - end; - - // Compression algorithms - TGIFCompression = - (gcLZW, // Normal LZW compression - gcRLE // GIF compatible RLE compression - ); - - // Color reduction methods - TColorReduction = - (rmNone, // Do not perform color reduction - rmWindows20, // Reduce to the Windows 20 color system palette - rmWindows256, // Reduce to the Windows 256 color halftone palette (Only works in 256 color display mode) - rmWindowsGray, // Reduce to the Windows 4 grayscale colors - rmMonochrome, // Reduce to a black/white monochrome palette - rmGrayScale, // Reduce to a uniform 256 shade grayscale palette - rmNetscape, // Reduce to the Netscape 216 color palette - rmQuantize, // Reduce to optimal 2^n color palette - rmQuantizeWindows, // Reduce to optimal 256 color windows palette - rmPalette // Reduce to custom palette - ); - TDitherMode = - (dmNearest, // Nearest color matching w/o error correction - dmFloydSteinberg, // Floyd Steinberg Error Diffusion dithering - dmStucki, // Stucki Error Diffusion dithering - dmSierra, // Sierra Error Diffusion dithering - dmJaJuNI, // Jarvis, Judice & Ninke Error Diffusion dithering - dmSteveArche, // Stevenson & Arche Error Diffusion dithering - dmBurkes // Burkes Error Diffusion dithering - // dmOrdered, // Ordered dither - ); - - // Optimization options - TGIFOptimizeOption = - (ooCrop, // Crop animated GIF frames - ooMerge, // Merge pixels of same color - ooCleanup, // Remove comments and application extensions - ooColorMap, // Sort color map by usage and remove unused entries - ooReduceColors // Reduce color depth ***NOT IMPLEMENTED*** - ); - TGIFOptimizeOptions = set of TGIFOptimizeOption; - - TGIFDrawOption = - (goAsync, // Asyncronous draws (paint in thread) - goTransparent, // Transparent draws - goAnimate, // Animate draws - goLoop, // Loop animations - goLoopContinously, // Ignore loop count and loop forever - goValidateCanvas, // Validate canvas in threaded paint ***NOT IMPLEMENTED*** - goDirectDraw, // Draw() directly on canvas - goClearOnLoop, // Clear animation on loop - goTile, // Tiled display - goDither, // Dither to Netscape palette - goAutoDither // Only dither on 256 color systems - ); - TGIFDrawOptions = set of TGIFDrawOption; - // Note: if goAsync is not set then goDirectDraw should be set. Otherwise - // the image will not be displayed. - - PGIFPainter = ^TGIFPainter; - - TGIFPainter = class(TThread) - private - FImage : TGIFImage; // The TGIFImage that owns this painter - FCanvas : TCanvas; // Destination canvas - FRect : TRect; // Destination rect - FDrawOptions : TGIFDrawOptions;// Paint options - FAnimationSpeed : integer; // Animation speed % - FActiveImage : integer; // Current frame - Disposal , // Used by synchronized paint - OldDisposal : TDisposalMethod;// Used by synchronized paint - BackupBuffer : TBitmap; // Used by synchronized paint - FrameBuffer : TBitmap; // Used by synchronized paint - Background : TBitmap; // Used by synchronized paint - ValidateDC : HDC; - DoRestart : boolean; // Flag used to restart animation - FStarted : boolean; // Flag used to signal start of paint - PainterRef : PGIFPainter; // Pointer to var referencing painter - FEventHandle : THandle; // Animation delay event - ExceptObject : Exception; // Eaten exception - ExceptAddress : pointer; // Eaten exceptions address - FEvent : TNotifyEvent; // Used by synchronized events - FOnStartPaint : TNotifyEvent; - FOnPaint : TNotifyEvent; - FOnAfterPaint : TNotifyEvent; - FOnLoop : TNotifyEvent; - FOnEndPaint : TNotifyEvent; - procedure DoOnTerminate(Sender: TObject);// Sync. shutdown procedure - procedure DoSynchronize(Method: TThreadMethod);// Conditional sync stub -{$ifdef SERIALIZE_RENDER} - procedure PrefetchBitmap; // Sync. bitmap prefetch -{$endif} - procedure DoPaintFrame; // Sync. buffered paint procedure - procedure DoPaint; // Sync. paint procedure - procedure DoEvent; - procedure SetActiveImage(const Value: integer);// Sync. event procedure - protected - procedure Execute; override; - procedure SetAnimationSpeed(Value: integer); - public - constructor Create(AImage: TGIFImage; ACanvas: TCanvas; ARect: TRect; - Options: TGIFDrawOptions); - constructor CreateRef(Painter: PGIFPainter; AImage: TGIFImage; ACanvas: TCanvas; ARect: TRect; - Options: TGIFDrawOptions); - destructor Destroy; override; - procedure Start; - procedure Stop; - procedure Restart; - property Image: TGIFImage read FImage; - property Canvas: TCanvas read FCanvas; - property Rect: TRect read FRect write FRect; - property DrawOptions: TGIFDrawOptions read FDrawOptions write FDrawOptions; - property AnimationSpeed: integer read FAnimationSpeed write SetAnimationSpeed; - property Started: boolean read FStarted; - property ActiveImage: integer read FActiveImage write SetActiveImage; - property OnStartPaint: TNotifyEvent read FOnStartPaint write FOnStartPaint; - property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; - property OnAfterPaint: TNotifyEvent read FOnAfterPaint write FOnAfterPaint; - property OnLoop: TNotifyEvent read FOnLoop write FOnLoop; - property OnEndPaint : TNotifyEvent read FOnEndPaint write FOnEndPaint ; - property EventHandle: THandle read FEventHandle; - end; - - TGIFWarning = procedure(Sender: TObject; Severity: TGIFSeverity; Message: string) of object; - - TGIFImage = class(TGraphic) - private - IsDrawing : Boolean; - IsInsideGetPalette : boolean; - FImages : TGIFImageList; - FHeader : TGIFHeader; - FGlobalPalette : HPalette; - FPainters : TThreadList; - FDrawOptions : TGIFDrawOptions; - FColorReduction : TColorReduction; - FReductionBits : integer; - FDitherMode : TDitherMode; - FCompression : TGIFCompression; - FOnWarning : TGIFWarning; - FBitmap : TBitmap; - FDrawPainter : TGIFPainter; - FThreadPriority : TThreadPriority; - FAnimationSpeed : integer; - FForceFrame: Integer; // 2004.03.09 - FDrawBackgroundColor: TColor; - FOnStartPaint : TNotifyEvent; - FOnPaint : TNotifyEvent; - FOnAfterPaint : TNotifyEvent; - FOnLoop : TNotifyEvent; - FOnEndPaint : TNotifyEvent; -{$IFDEF VER9x} - FPaletteModified : Boolean; - FOnProgress : TProgressEvent; -{$ENDIF} - function GetAnimate: Boolean; // 2002.07.07 - procedure SetAnimate(const Value: Boolean); // 2002.07.07 - procedure SetForceFrame(const Value: Integer); // 2004.03.09 - protected - // Obsolete: procedure Changed(Sender: TObject); {$IFDEF VER9x} virtual; {$ELSE} override; {$ENDIF} - function GetHeight: Integer; override; - procedure SetHeight(Value: Integer); override; - function GetWidth: Integer; override; - procedure SetWidth(Value: Integer); override; - procedure AssignTo(Dest: TPersistent); override; - function InternalPaint(Painter: PGIFPainter; ACanvas: TCanvas; const Rect: TRect; Options: TGIFDrawOptions): TGIFPainter; - procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; - function Equals(Graphic: TGraphic): Boolean; override; - function GetPalette: HPALETTE; {$IFDEF VER9x} virtual; {$ELSE} override; {$ENDIF} - procedure SetPalette(Value: HPalette); {$IFDEF VER9x} virtual; {$ELSE} override; {$ENDIF} - function GetEmpty: Boolean; override; - procedure WriteData(Stream: TStream); override; - function GetIsTransparent: Boolean; - function GetVersion: TGIFVersion; - function GetColorResolution: integer; - function GetBitsPerPixel: integer; - function GetBackgroundColorIndex: BYTE; - procedure SetBackgroundColorIndex(const Value: BYTE); - function GetBackgroundColor: TColor; - procedure SetBackgroundColor(const Value: TColor); - function GetAspectRatio: BYTE; - procedure SetAspectRatio(const Value: BYTE); - procedure SetDrawOptions(Value: TGIFDrawOptions); - procedure SetAnimationSpeed(Value: integer); - procedure SetReductionBits(Value: integer); - procedure NewImage; - function GetBitmap: TBitmap; - function NewBitmap: TBitmap; - procedure FreeBitmap; - function GetColorMap: TGIFColorMap; - function GetDoDither: boolean; - property DrawPainter: TGIFPainter read FDrawPainter; // Extremely volatile - property DoDither: boolean read GetDoDither; -{$IFDEF VER9x} - procedure Progress(Sender: TObject; Stage: TProgressStage; - PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic; -{$ENDIF} -{$IFDEF FIXHEADER_WIDTHHEIGHT_SILENT} - procedure FixHeaderWidthHeight; // 2006.07.09 -{$ENDIF} - public - constructor Create; override; - destructor Destroy; override; - procedure SaveToStream(Stream: TStream); override; - procedure LoadFromStream(Stream: TStream); override; - procedure LoadFromResourceName(Instance: THandle; const ResName: String); // 2002.07.07 - function Add(Source: TPersistent): integer; - procedure Pack; - procedure OptimizeColorMap; - procedure Optimize(Options: TGIFOptimizeOptions; - ColorReduction: TColorReduction; DitherMode: TDitherMode; - ReductionBits: integer); - procedure Clear; - procedure StopDraw; - function Paint(ACanvas: TCanvas; const Rect: TRect; Options: TGIFDrawOptions): TGIFPainter; - procedure PaintStart; - procedure PaintPause; - procedure PaintStop; - procedure PaintResume; - procedure PaintRestart; - procedure Warning(Sender: TObject; Severity: TGIFSeverity; Message: string); virtual; - procedure Assign(Source: TPersistent); override; - procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; - APalette: HPALETTE); override; - procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; - var APalette: HPALETTE); override; - property GlobalColorMap: TGIFColorMap read GetColorMap; - property Version: TGIFVersion read GetVersion; - property Images: TGIFImageList read FImages; - property ColorResolution: integer read GetColorResolution; - property BitsPerPixel: integer read GetBitsPerPixel; - property BackgroundColorIndex: BYTE read GetBackgroundColorIndex write SetBackgroundColorIndex; - property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor; - property AspectRatio: BYTE read GetAspectRatio write SetAspectRatio; - property Header: TGIFHeader read FHeader; // ***OBSOLETE*** - property IsTransparent: boolean read GetIsTransparent; - property DrawOptions: TGIFDrawOptions read FDrawOptions write SetDrawOptions; - property DrawBackgroundColor: TColor read FDrawBackgroundColor write FDrawBackgroundColor; - property ColorReduction: TColorReduction read FColorReduction write FColorReduction; - property ReductionBits: integer read FReductionBits write SetReductionBits; - property DitherMode: TDitherMode read FDitherMode write FDitherMode; - property Compression: TGIFCompression read FCompression write FCompression; - property AnimationSpeed: integer read FAnimationSpeed write SetAnimationSpeed; - property Animate: Boolean read GetAnimate write SetAnimate; // 2002.07.07 - property ForceFrame: Integer read FForceFrame write SetForceFrame; // 2004.03.09 - property Painters: TThreadList read FPainters; - property ThreadPriority: TThreadPriority read FThreadPriority write FThreadPriority; - property Bitmap: TBitmap read GetBitmap; // Volatile - beware! - property OnWarning: TGIFWarning read FOnWarning write FOnWarning; - property OnStartPaint: TNotifyEvent read FOnStartPaint write FOnStartPaint; - property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; - property OnAfterPaint: TNotifyEvent read FOnAfterPaint write FOnAfterPaint; - property OnLoop: TNotifyEvent read FOnLoop write FOnLoop; - property OnEndPaint : TNotifyEvent read FOnEndPaint write FOnEndPaint ; -{$IFDEF VER9x} - property Palette: HPALETTE read GetPalette write SetPalette; - property PaletteModified: Boolean read FPaletteModified write FPaletteModified; - property OnProgress: TProgressEvent read FOnProgress write FOnProgress; -{$ENDIF} - end; - -//////////////////////////////////////////////////////////////////////////////// -// -// Utility routines -// -//////////////////////////////////////////////////////////////////////////////// - // WebPalette creates a 216 color uniform palette a.k.a. the Netscape Palette - function WebPalette: HPalette; - - // ReduceColors - // Map colors in a bitmap to their nearest representation in a palette using - // the methods specified by the ColorReduction and DitherMode parameters. - // The ReductionBits parameter specifies the desired number of colors (bits - // per pixel) when the reduction method is rmQuantize. The CustomPalette - // specifies the palette when the rmPalette reduction method is used. - function ReduceColors(Bitmap: TBitmap; ColorReduction: TColorReduction; - DitherMode: TDitherMode; ReductionBits: integer; CustomPalette: hPalette): TBitmap; - - // CreateOptimizedPaletteFromManyBitmaps - //: Performs Color Quantization on multiple bitmaps. - // The Bitmaps parameter is a list of bitmaps. Returns an optimized palette. - function CreateOptimizedPaletteFromManyBitmaps(Bitmaps: TList; Colors, ColorBits: integer; - Windows: boolean): hPalette; - -{$IFDEF VER9x} - // From Delphi 3 graphics.pas -type - TPixelFormat = (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfCustom); -{$ENDIF} - - procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer; - var ImageSize: longInt; PixelFormat: TPixelFormat); - function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE; - var BitmapInfo; var Bits; PixelFormat: TPixelFormat): Boolean; - -//////////////////////////////////////////////////////////////////////////////// -// -// Global variables -// -//////////////////////////////////////////////////////////////////////////////// -// GIF Clipboard format identifier for use by LoadFromClipboardFormat and -// SaveToClipboardFormat. -// Set in Initialization section. -var - CF_GIF: WORD; - -//////////////////////////////////////////////////////////////////////////////// -// -// Library defaults -// -//////////////////////////////////////////////////////////////////////////////// -var - //: Default options for TGIFImage.DrawOptions. - GIFImageDefaultDrawOptions : TGIFDrawOptions = - [goAsync, goLoop, goTransparent, goAnimate, goDither, goAutoDither -{$IFDEF STRICT_MOZILLA} - ,goClearOnLoop -{$ENDIF} -{$IFDEF DEFAULT_GOCLEARLOOP} // 2006.07.10 - ,goClearOnLoop -{$ENDIF} - ]; - - // WARNING! Do not use goAsync and goDirectDraw unless you have absolute - // control of the destination canvas. - // TGIFPainter will continue to write on the canvas even after the canvas has - // been deleted, unless *you* prevent it. - // The goValidateCanvas option will fix this problem if it is ever implemented. - - //: Default color reduction methods for bitmap import. - // These are the fastest settings, but also the ones that gives the - // worst result (in most cases). - GIFImageDefaultColorReduction: TColorReduction = rmNetscape; - GIFImageDefaultColorReductionBits: integer = 8; // Range 3 - 8 - GIFImageDefaultDitherMode: TDitherMode = dmNearest; - - //: Default encoder compression method. - GIFImageDefaultCompression: TGIFCompression = gcLZW; - - //: Default painter thread priority - GIFImageDefaultThreadPriority: TThreadPriority = tpNormal; - - //: Default animation speed in % of normal speed (range 0 - 1000) - GIFImageDefaultAnimationSpeed: integer = 100; - - // DoAutoDither is set to True in the initializaion section if the desktop DC - // supports 256 colors or less. - // It can be modified in your application to disable/enable Auto Dithering - DoAutoDither: boolean = False; - - // Palette is set to True in the initialization section if the desktop DC - // supports 256 colors or less. - // You should NOT modify it. - PaletteDevice: boolean = False; - - // Set GIFImageRenderOnLoad to True to render (convert to bitmap) the - // GIF frames as they are loaded instead of rendering them on-demand. - // This might increase resource consumption and will increase load time, - // but will cause animated GIFs to display more smoothly. - GIFImageRenderOnLoad: boolean = False; - - // If GIFImageOptimizeOnStream is true, the GIF will be optimized - // before it is streamed to the DFM file. - // This will not affect TGIFImage.SaveToStream or SaveToFile. - GIFImageOptimizeOnStream: boolean = False; - -//////////////////////////////////////////////////////////////////////////////// -// -// Design Time support -// -//////////////////////////////////////////////////////////////////////////////// -// Dummy component registration for design time support of GIFs in TImage -procedure Register; - -//////////////////////////////////////////////////////////////////////////////// -// -// Error messages -// -//////////////////////////////////////////////////////////////////////////////// -{$ifndef VER9x} -resourcestring -{$else} -const -{$endif} - // GIF Error messages - sOutOfData = 'Premature end of data'; - sTooManyColors = 'Color table overflow'; - sBadColorIndex = 'Invalid color index'; - sBadVersion = 'Unsupported GIF version'; - sBadSignature = 'Invalid GIF signature'; - sScreenBadColorSize = 'Invalid number of colors specified in Screen Descriptor'; - sImageBadColorSize = 'Invalid number of colors specified in Image Descriptor'; - sUnknownExtension = 'Unknown extension type'; - sBadExtensionLabel = 'Invalid extension introducer'; - sOutOfMemDIB = 'Failed to allocate memory for GIF DIB'; - sDIBCreate = 'Failed to create DIB from Bitmap'; - sDecodeTooFewBits = 'Decoder bit buffer under-run'; - sDecodeCircular = 'Circular decoder table entry'; - sBadTrailer = 'Invalid Image trailer'; - sBadExtensionInstance = 'Internal error: Extension Instance does not match Extension Label'; - sBadBlockSize = 'Unsupported Application Extension block size'; - sBadBlock = 'Unknown GIF block type'; - sUnsupportedClass = 'Object type not supported for operation'; - sInvalidData = 'Invalid GIF data'; - sBadHeight = 'Image height too small for contained frames'; - sBadWidth = 'Image width too small for contained frames'; -{$IFNDEF REGISTER_TGIFIMAGE} - sGIFToClipboard = 'Clipboard operations not supported for GIF objects'; -{$ELSE} - sFailedPaste = 'Failed to store GIF on clipboard'; -{$IFDEF VER9x} - sUnknownClipboardFormat= 'Unsupported clipboard format'; -{$ENDIF} -{$ENDIF} - sScreenSizeExceeded = 'Image exceeds Logical Screen size'; - sNoColorTable = 'No global or local color table defined'; - sBadPixelCoordinates = 'Invalid pixel coordinates'; - sUnsupportedBitmap = 'Unsupported bitmap format'; - sInvalidPixelFormat = 'Unsupported PixelFormat'; - sBadDimension = 'Invalid image dimensions'; - sNoDIB = 'Image has no DIB'; - sInvalidStream = 'Invalid stream operation'; - sInvalidColor = 'Color not in color table'; - sInvalidBitSize = 'Invalid Bits Per Pixel value'; - sEmptyColorMap = 'Color table is empty'; - sEmptyImage = 'Image is empty'; - sInvalidBitmapList = 'Invalid bitmap list'; - sInvalidReduction = 'Invalid reduction method'; -{$IFDEF VER9x} - // From Delphi 3 consts.pas - SOutOfResources = 'Out of system resources'; - SInvalidBitmap = 'Bitmap image is not valid'; - SScanLine = 'Scan line index out of range'; -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// -// Misc texts -// -//////////////////////////////////////////////////////////////////////////////// - // File filter name - sGIFImageFile = 'GIF Image'; - - // Progress messages - sProgressLoading = 'Loading...'; - sProgressSaving = 'Saving...'; - sProgressConverting = 'Converting...'; - sProgressRendering = 'Rendering...'; - sProgressCopying = 'Copying...'; - sProgressOptimizing = 'Optimizing...'; - - -//////////////////////////////////////////////////////////////////////////////// -//////////////////////////////////////////////////////////////////////////////// -// -// Implementation -// -//////////////////////////////////////////////////////////////////////////////// -//////////////////////////////////////////////////////////////////////////////// -implementation - -{ This makes me long for the C preprocessor... } -{$ifdef DEBUG} - {$ifdef DEBUG_COMPRESSPERFORMANCE} - {$define DEBUG_PERFORMANCE} - {$else} - {$ifdef DEBUG_DECOMPRESSPERFORMANCE} - {$define DEBUG_PERFORMANCE} - {$else} - {$ifdef DEBUG_DITHERPERFORMANCE} - {$define DEBUG_PERFORMANCE} - {$else} - {$ifdef DEBUG_DITHERPERFORMANCE} - {$define DEBUG_PERFORMANCE} - {$else} - {$ifdef DEBUG_DRAWPERFORMANCE} - {$define DEBUG_PERFORMANCE} - {$else} - {$ifdef DEBUG_RENDERPERFORMANCE} - {$define DEBUG_PERFORMANCE} - {$endif} - {$endif} - {$endif} - {$endif} - {$endif} - {$endif} -{$endif} - -uses -{$ifdef DEBUG} - dialogs, -{$endif} - mmsystem, // timeGetTime() - messages, - Consts; - -//////////////////////////////////////////////////////////////////////////////// -// -// Misc consts -// -//////////////////////////////////////////////////////////////////////////////// -const - { Extension/block label values } - bsPlainTextExtension = $01; - bsGraphicControlExtension = $F9; - bsCommentExtension = $FE; - bsApplicationExtension = $FF; - - bsImageDescriptor = Ord(','); - bsExtensionIntroducer = Ord('!'); - bsTrailer = ord(';'); - - // Thread messages - Used by TThread.Synchronize() - CM_DESTROYWINDOW = $8FFE; // Defined in classes.pas - CM_EXECPROC = $8FFF; // Defined in classes.pas - - -//////////////////////////////////////////////////////////////////////////////// -// -// Design Time support -// -//////////////////////////////////////////////////////////////////////////////// -//: Dummy component registration to add design-time support of GIFs to TImage. -// Since TGIFImage isn't a component there's nothing to register here, but -// since Register is only called at design time we can set the design time -// GIF paint options here (modify as you please): -procedure Register; -begin - // Don't loop animations at design-time. Animated GIFs will animate once and - // then stop thus not using CPU resources and distracting the developer. - Exclude(GIFImageDefaultDrawOptions, goLoop); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// Utilities -// -//////////////////////////////////////////////////////////////////////////////// -//: Creates a 216 color uniform non-dithering Netscape palette. -function WebPalette: HPalette; -type - TLogWebPalette = packed record - palVersion : word; - palNumEntries : word; - PalEntries : array[0..5,0..5,0..5] of TPaletteEntry; - end; -var - r, g, b : byte; - LogWebPalette : TLogWebPalette; - LogPalette : TLogpalette absolute LogWebPalette; // Stupid typecast -begin - with LogWebPalette do - begin - palVersion:= $0300; - palNumEntries:= 216; - for r:=0 to 5 do - for g:=0 to 5 do - for b:=0 to 5 do - begin - with PalEntries[r,g,b] do - begin - peRed := 51 * r; - peGreen := 51 * g; - peBlue := 51 * b; - peFlags := 0; - end; - end; - end; - Result := CreatePalette(Logpalette); -end; - -(* -** GDI Error handling -** Adapted from graphics.pas -*) -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -{$ifdef D3_BCB3} -function GDICheck(Value: Integer): Integer; -{$else} -function GDICheck(Value: Cardinal): Cardinal; -{$endif} -var - ErrorCode : integer; -// 2008.10.19 -> -{$IFDEF VER20_PLUS} - Buf : array [byte] of WideChar; -{$ELSE} - Buf : array [byte] of AnsiChar; -{$ENDIF} -// 2008.10.19 <- - - function ReturnAddr: Pointer; - // From classes.pas - asm - MOV EAX,[EBP+4] // sysutils.pas says [EBP-4], but this works ! - end; - -begin - if (Value = 0) then - begin - ErrorCode := GetLastError; - if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, - ErrorCode, LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil) <> 0) then - raise EOutOfResources.Create(Buf) at ReturnAddr - else - raise EOutOfResources.Create(SOutOfResources) at ReturnAddr; - end; - Result := Value; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -(* -** Raise error condition -*) -procedure Error(msg: string); - function ReturnAddr: Pointer; - // From classes.pas - asm - MOV EAX,[EBP+4] // sysutils.pas says [EBP-4] ! - end; -begin - raise GIFException.Create(msg) at ReturnAddr; -end; - -(* -** Return number bytes required to -** hold a given number of bits. -*) -function ByteAlignBit(Bits: Cardinal): Cardinal; -begin - Result := (Bits+7) SHR 3; -end; -// Rounded up to nearest 2 -function WordAlignBit(Bits: Cardinal): Cardinal; -begin - Result := ((Bits+15) SHR 4) SHL 1; -end; -// Rounded up to nearest 4 -function DWordAlignBit(Bits: Cardinal): Cardinal; -begin - Result := ((Bits+31) SHR 5) SHL 2; -end; -// Round to arbitrary number of bits -function AlignBit(Bits, BitsPerPixel, Alignment: Cardinal): Cardinal; -begin - Dec(Alignment); - Result := ((Bits * BitsPerPixel) + Alignment) and not Alignment; - Result := Result SHR 3; -end; - -(* -** Compute Bits per Pixel from Number of Colors -** (Return the ceiling log of n) -*) -function Colors2bpp(Colors: integer): integer; -var - MaxColor : integer; -begin - (* - ** This might be faster computed by multiple if then else statements - *) - - if (Colors = 0) then - Result := 0 - else - begin - Result := 1; - MaxColor := 2; - while (Colors > MaxColor) do - begin - inc(Result); - MaxColor := MaxColor SHL 1; - end; - end; -end; - -(* -** Write an ordinal byte value to a stream -*) -procedure WriteByte(Stream: TStream; b: BYTE); -begin - Stream.Write(b, 1); -end; - -(* -** Read an ordinal byte value from a stream -*) -function ReadByte(Stream: TStream): BYTE; -begin - Stream.Read(Result, 1); -end; - -(* -** Read data from stream and raise exception of EOF -*) -procedure ReadCheck(Stream: TStream; var Buffer; Size: LongInt); -var - ReadSize : integer; -begin - ReadSize := Stream.Read(Buffer, Size); - if (ReadSize <> Size) then - Error(sOutOfData); -end; - -(* -** Write a string list to a stream as multiple blocks -** of max 255 characters in each. -*) -procedure WriteStrings(Stream: TStream; Text: TStrings); -var - i : integer; - b : BYTE; - size : integer; - s : AnsiString; -begin - for i := 0 to Text.Count-1 do - begin - s := AnsiString(Text[i]); - size := length(s); - if (size > 255) then - b := 255 - else - b := size; - while (size > 0) do - begin - dec(size, b); - WriteByte(Stream, b); -// 2008.10.19 -> -// Stream.Write(PChar(s)^, b); - Stream.Write(PByte(s)^, b); -// 2008.10.19 <- - delete(s, 1, b); - if (b > size) then - b := size; - end; - end; - // Terminating zero (length = 0) - WriteByte(Stream, 0); -end; - - -(* -** Read a string list from a stream as multiple blocks -** of max 255 characters in each. -*) -{.TODO -oanme -cImprovement : Replace ReadStrings with TGIFReader. } -procedure ReadStrings(Stream: TStream; Text: TStrings); -var - size : BYTE; - buf : array[0..255] of AnsiChar; -begin - Text.Clear; - if (Stream.Read(size, 1) <> 1) then - exit; - while (size > 0) do - begin - ReadCheck(Stream, buf, size); - buf[size] := #0; -// 2008.10.19 -> -// Text.Add(Buf); - Text.Add(string(Buf)); -// 2008.10.19 <- - if (Stream.Read(size, 1) <> 1) then - exit; - end; -end; - - -//////////////////////////////////////////////////////////////////////////////// -// -// Delphi 2.x / C++ Builder 1.x support -// -//////////////////////////////////////////////////////////////////////////////// -{$IFDEF VER9x} -var - // From Delphi 3 graphics.pas - SystemPalette16: HPalette; // 16 color palette that maps to the system palette - -type - TPixelFormats = set of TPixelFormat; - -const - // Only pf1bit, pf4bit and pf8bit is supported since they are the only ones - // with palettes - SupportedPixelformats: TPixelFormats = [pf1bit, pf4bit, pf8bit]; -{$ENDIF} - - -// -------------------------- -// InitializeBitmapInfoHeader -// -------------------------- -// Fills a TBitmapInfoHeader with the values of a bitmap when converted to a -// DIB of a specified PixelFormat. -// -// Parameters: -// Bitmap The handle of the source bitmap. -// Info The TBitmapInfoHeader buffer that will receive the values. -// PixelFormat The pixel format of the destination DIB. -// -{$IFDEF BAD_STACK_ALIGNMENT} - // Disable optimization to circumvent optimizer bug... - {$IFOPT O+} - {$DEFINE O_PLUS} - {$O-} - {$ENDIF} -{$ENDIF} -procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var Info: TBitmapInfoHeader; - PixelFormat: TPixelFormat); -// From graphics.pas, "optimized" for our use -var - DIB : TDIBSection; - Bytes : Integer; -begin - DIB.dsbmih.biSize := 0; - Bytes := GetObject(Bitmap, SizeOf(DIB), @DIB); - if (Bytes = 0) then - Error(sInvalidBitmap); - - if (Bytes >= (sizeof(DIB.dsbm) + sizeof(DIB.dsbmih))) and - (DIB.dsbmih.biSize >= sizeof(DIB.dsbmih)) then - Info := DIB.dsbmih - else - begin - FillChar(Info, sizeof(Info), 0); - with Info, DIB.dsbm do - begin - biSize := SizeOf(Info); - biWidth := bmWidth; - biHeight := bmHeight; - end; - end; - case PixelFormat of - pf1bit: Info.biBitCount := 1; - pf4bit: Info.biBitCount := 4; - pf8bit: Info.biBitCount := 8; - pf24bit: Info.biBitCount := 24; - else - Error(sInvalidPixelFormat); - // Info.biBitCount := DIB.dsbm.bmBitsPixel * DIB.dsbm.bmPlanes; - end; - Info.biPlanes := 1; - Info.biCompression := BI_RGB; // Always return data in RGB format - Info.biSizeImage := AlignBit(Info.biWidth, Info.biBitCount, 32) * Cardinal(abs(Info.biHeight)); -end; -{$IFDEF O_PLUS} - {$O+} - {$UNDEF O_PLUS} -{$ENDIF} - -// ------------------- -// InternalGetDIBSizes -// ------------------- -// Calculates the buffer sizes nescessary for convertion of a bitmap to a DIB -// of a specified PixelFormat. -// See the GetDIBSizes API function for more info. -// -// Parameters: -// Bitmap The handle of the source bitmap. -// InfoHeaderSize -// The returned size of a buffer that will receive the DIB's -// TBitmapInfo structure. -// ImageSize The returned size of a buffer that will receive the DIB's -// pixel data. -// PixelFormat The pixel format of the destination DIB. -// -procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer; - var ImageSize: longInt; PixelFormat: TPixelFormat); -// From graphics.pas, "optimized" for our use -var - Info : TBitmapInfoHeader; -begin - InitializeBitmapInfoHeader(Bitmap, Info, PixelFormat); - // Check for palette device format - if (Info.biBitCount > 8) then - begin - // Header but no palette - InfoHeaderSize := SizeOf(TBitmapInfoHeader); - if ((Info.biCompression and BI_BITFIELDS) <> 0) then - Inc(InfoHeaderSize, 12); - end else - // Header and palette - InfoHeaderSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) * (1 shl Info.biBitCount); - ImageSize := Info.biSizeImage; -end; - -// -------------- -// InternalGetDIB -// -------------- -// Converts a bitmap to a DIB of a specified PixelFormat. -// -// Parameters: -// Bitmap The handle of the source bitmap. -// Pal The handle of the source palette. -// BitmapInfo The buffer that will receive the DIB's TBitmapInfo structure. -// A buffer of sufficient size must have been allocated prior to -// calling this function. -// Bits The buffer that will receive the DIB's pixel data. -// A buffer of sufficient size must have been allocated prior to -// calling this function. -// PixelFormat The pixel format of the destination DIB. -// -// Returns: -// True on success, False on failure. -// -// Note: The InternalGetDIBSizes function can be used to calculate the -// nescessary sizes of the BitmapInfo and Bits buffers. -// -function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE; - var BitmapInfo; var Bits; PixelFormat: TPixelFormat): Boolean; -// From graphics.pas, "optimized" for our use -var - OldPal : HPALETTE; - DC : HDC; -begin - InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), PixelFormat); - OldPal := 0; - DC := CreateCompatibleDC(0); - try - if (Palette <> 0) then - begin - OldPal := SelectPalette(DC, Palette, False); - RealizePalette(DC); - end; - Result := (GetDIBits(DC, Bitmap, 0, abs(TBitmapInfoHeader(BitmapInfo).biHeight), - @Bits, TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0); - finally - if (OldPal <> 0) then - SelectPalette(DC, OldPal, False); - DeleteDC(DC); - end; -end; - -// ---------- -// DIBFromBit -// ---------- -// Converts a bitmap to a DIB of a specified PixelFormat. -// The DIB is returned in a TMemoryStream ready for streaming to a BMP file. -// -// Note: As opposed to D2's DIBFromBit function, the returned stream also -// contains a TBitmapFileHeader at offset 0. -// -// Parameters: -// Stream The TMemoryStream used to store the bitmap data. -// The stream must be allocated and freed by the caller prior to -// calling this function. -// Src The handle of the source bitmap. -// Pal The handle of the source palette. -// PixelFormat The pixel format of the destination DIB. -// DIBHeader A pointer to the DIB's TBitmapInfo (or TBitmapInfoHeader) -// structure in the memory stream. -// The size of the structure can either be deduced from the -// pixel format (i.e. number of colors) or calculated by -// subtracting the DIBHeader pointer from the DIBBits pointer. -// DIBBits A pointer to the DIB's pixel data in the memory stream. -// -procedure DIBFromBit(Stream: TMemoryStream; Src: HBITMAP; - Pal: HPALETTE; PixelFormat: TPixelFormat; var DIBHeader, DIBBits: Pointer); -// (From D2 graphics.pas, "optimized" for our use) -var - HeaderSize : integer; - FileSize : longInt; - ImageSize : longInt; - BitmapFileHeader : PBitmapFileHeader; -begin - if (Src = 0) then - Error(sInvalidBitmap); - // Get header- and pixel data size for new pixel format - InternalGetDIBSizes(Src, HeaderSize, ImageSize, PixelFormat); - // Make room in stream for a TBitmapInfo and pixel data - FileSize := sizeof(TBitmapFileHeader) + HeaderSize + ImageSize; - Stream.SetSize(FileSize); - // Get pointer to TBitmapFileHeader - BitmapFileHeader := Stream.Memory; - // Get pointer to TBitmapInfo - DIBHeader := Pointer(Longint(BitmapFileHeader) + sizeof(TBitmapFileHeader)); - // Get pointer to pixel data - DIBBits := Pointer(Longint(DIBHeader) + HeaderSize); - // Initialize file header - FillChar(BitmapFileHeader^, sizeof(TBitmapFileHeader), 0); - with BitmapFileHeader^ do - begin - bfType := $4D42; // 'BM' = Windows BMP signature - bfSize := FileSize; // File size (not needed) - bfOffBits := sizeof(TBitmapFileHeader) + HeaderSize; // Offset of pixel data - end; - // Get pixel data in new pixel format - InternalGetDIB(Src, Pal, DIBHeader^, DIBBits^, PixelFormat); -end; - -// -------------- -// GetPixelFormat -// -------------- -// Returns the current pixel format of a bitmap. -// -// Replacement for delphi 3 TBitmap.PixelFormat getter. -// -// Parameters: -// Bitmap The bitmap which pixel format is returned. -// -// Returns: -// The PixelFormat of the bitmap -// -function GetPixelFormat(Bitmap: TBitmap): TPixelFormat; -{$IFDEF VER9x} -// From graphics.pas, "optimized" for our use -var - DIBSection : TDIBSection; - Bytes : Integer; - Handle : HBitmap; -begin - Result := pfCustom; // This value is never returned - // BAD_STACK_ALIGNMENT - // Note: To work around an optimizer bug, we do not use Bitmap.Handle - // directly. Instead we store the value and use it indirectly. Unless we do - // this, the register containing Bitmap.Handle will be overwritten! - Handle := Bitmap.Handle; - if (Handle <> 0) then - begin - Bytes := GetObject(Handle, SizeOf(DIBSection), @DIBSection); - if (Bytes = 0) then - Error(sInvalidBitmap); - - with (DIBSection) do - begin - // Check for NT bitmap - if (Bytes < (SizeOf(dsbm) + SizeOf(dsbmih))) or (dsbmih.biSize < SizeOf(dsbmih)) then - DIBSection.dsBmih.biBitCount := dsbm.bmBitsPixel * dsbm.bmPlanes; - - case (dsBmih.biBitCount) of - 0: Result := pfDevice; - 1: Result := pf1bit; - 4: Result := pf4bit; - 8: Result := pf8bit; - 16: case (dsBmih.biCompression) of - BI_RGB: - Result := pf15Bit; - BI_BITFIELDS: - if (dsBitFields[1] = $07E0) then - Result := pf16Bit; - end; - 24: Result := pf24Bit; - 32: if (dsBmih.biCompression = BI_RGB) then - Result := pf32Bit; - else - Error(sUnsupportedBitmap); - end; - end; - end else -// Result := pfDevice; - Error(sUnsupportedBitmap); -end; -{$ELSE} -begin - Result := Bitmap.PixelFormat; -end; -{$ENDIF} - -// -------------- -// SetPixelFormat -// -------------- -// Changes the pixel format of a TBitmap. -// -// Replacement for delphi 3 TBitmap.PixelFormat setter. -// The returned TBitmap will always be a DIB. -// -// Note: Under Delphi 3.x this function will leak a palette handle each time it -// converts a TBitmap to pf8bit format! -// If possible, use SafeSetPixelFormat instead to avoid this. -// -// Parameters: -// Bitmap The bitmap to modify. -// PixelFormat The pixel format to convert to. -// -procedure SetPixelFormat(Bitmap: TBitmap; PixelFormat: TPixelFormat); -{$IFDEF VER9x} -var - Stream : TMemoryStream; - Header , - Bits : Pointer; -begin - // Can't change anything without a handle - if (Bitmap.Handle = 0) then - Error(sInvalidBitmap); - - // Only convert to supported formats - if not(PixelFormat in SupportedPixelformats) then - Error(sInvalidPixelFormat); - - // No need to convert to same format - if (GetPixelFormat(Bitmap) = PixelFormat) then - exit; - - Stream := TMemoryStream.Create; - try - // Convert to DIB file in memory stream - DIBFromBit(Stream, Bitmap.Handle, Bitmap.Palette, PixelFormat, Header, Bits); - // Load DIB from stream - Stream.Position := 0; - Bitmap.LoadFromStream(Stream); - finally - Stream.Free; - end; -end; -{$ELSE} -begin - Bitmap.PixelFormat := PixelFormat; -end; -{$ENDIF} - -{$IFDEF VER100} -var - pf8BitBitmap: TBitmap = nil; -{$ENDIF} - -// ------------------ -// SafeSetPixelFormat -// ------------------ -// Changes the pixel format of a TBitmap but doesn't preserve the contents. -// -// Replacement for Delphi 3 TBitmap.PixelFormat setter. -// The returned TBitmap will always be an empty DIB of the same size as the -// original bitmap. -// -// This function is used to avoid the palette handle leak that Delphi 3's -// SetPixelFormat and TBitmap.PixelFormat suffers from. -// -// Parameters: -// Bitmap The bitmap to modify. -// PixelFormat The pixel format to convert to. -// -procedure SafeSetPixelFormat(Bitmap: TBitmap; PixelFormat: TPixelFormat); -{$IFDEF VER9x} -begin - SetPixelFormat(Bitmap, PixelFormat); -end; -{$ELSE} -{$IFNDEF VER100} -var - Palette : hPalette; -begin - Bitmap.PixelFormat := PixelFormat; - - // Work around a bug in TBitmap: - // When converting to pf8bit format, the palette assigned to TBitmap.Palette - // will be a half tone palette (which only contains the 20 system colors). - // Unfortunately this is not the palette used to render the bitmap and it - // is also not the palette saved with the bitmap. - if (PixelFormat = pf8bit) then - begin - // Disassociate the wrong palette from the bitmap (without affecting - // the DIB color table) - Palette := Bitmap.ReleasePalette; - if (Palette <> 0) then - DeleteObject(Palette); - // Recreate the palette from the DIB color table - Bitmap.Palette; - end; -end; -{$ELSE} -var - Width , - Height : integer; -begin - if (PixelFormat = pf8bit) then - begin - // Partial solution to "TBitmap.PixelFormat := pf8bit" leak - // by Greg Chapman <glc@well.com> - if (pf8BitBitmap = nil) then - begin - // Create a "template" bitmap - // The bitmap is deleted in the finalization section of the unit. - pf8BitBitmap:= TBitmap.Create; - // Convert template to pf8bit format - // This will leak 1 palette handle, but only once - pf8BitBitmap.PixelFormat:= pf8Bit; - end; - // Store the size of the original bitmap - Width := Bitmap.Width; - Height := Bitmap.Height; - // Convert to pf8bit format by copying template - Bitmap.Assign(pf8BitBitmap); - // Restore the original size - Bitmap.Width := Width; - Bitmap.Height := Height; - end else - // This is safe since only pf8bit leaks - Bitmap.PixelFormat := PixelFormat; -end; -{$ENDIF} -{$ENDIF} - - -{$IFDEF VER9x} - -// ----------- -// CopyPalette -// ----------- -// Copies a HPALETTE. -// -// Copied from D3 graphics.pas. -// This is declared private in some old versions of Delphi 2 so we have to -// implement it here to support those old versions. -// -// Parameters: -// Palette The palette to copy. -// -// Returns: -// The handle to a new palette. -// -function CopyPalette(Palette: HPALETTE): HPALETTE; -var - PaletteSize: Integer; - LogPal: TMaxLogPalette; -begin - Result := 0; - if Palette = 0 then Exit; - PaletteSize := 0; - if GetObject(Palette, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit; - if PaletteSize = 0 then Exit; - with LogPal do - begin - palVersion := $0300; - palNumEntries := PaletteSize; - GetPaletteEntries(Palette, 0, PaletteSize, palPalEntry); - end; - Result := CreatePalette(PLogPalette(@LogPal)^); -end; - - -// TThreadList implementation from Delphi 3 classes.pas -constructor TThreadList.Create; -begin - inherited Create; - InitializeCriticalSection(FLock); - FList := TList.Create; -end; - -destructor TThreadList.Destroy; -begin - LockList; // Make sure nobody else is inside the list. - try - FList.Free; - inherited Destroy; - finally - UnlockList; - DeleteCriticalSection(FLock); - end; -end; - -procedure TThreadList.Add(Item: Pointer); -begin - LockList; - try - if FList.IndexOf(Item) = -1 then - FList.Add(Item); - finally - UnlockList; - end; -end; - -procedure TThreadList.Clear; -begin - LockList; - try - FList.Clear; - finally - UnlockList; - end; -end; - -function TThreadList.LockList: TList; -begin - EnterCriticalSection(FLock); - Result := FList; -end; - -procedure TThreadList.Remove(Item: Pointer); -begin - LockList; - try - FList.Remove(Item); - finally - UnlockList; - end; -end; - -procedure TThreadList.UnlockList; -begin - LeaveCriticalSection(FLock); -end; -// End of TThreadList implementation - -// From Delphi 3 sysutils.pas -{ CompareMem performs a binary compare of Length bytes of memory referenced - by P1 to that of P2. CompareMem returns True if the memory referenced by - P1 is identical to that of P2. } -function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler; -asm - PUSH ESI - PUSH EDI - MOV ESI,P1 - MOV EDI,P2 - MOV EDX,ECX - XOR EAX,EAX - AND EDX,3 - SHR ECX,1 - SHR ECX,1 - REPE CMPSD - JNE @@2 - MOV ECX,EDX - REPE CMPSB - JNE @@2 -@@1: INC EAX -@@2: POP EDI - POP ESI -end; - -// Dummy ASSERT procedure since ASSERT does not exist in Delphi 2.x -procedure ASSERT(Condition: boolean; Message: string); -begin -end; - -{$ENDIF} // Delphi 2.x stuff - -//////////////////////////////////////////////////////////////////////////////// -// -// TDIB Classes -// -// These classes gives read and write access to TBitmap's pixel data -// independently of the Delphi version used. -// -//////////////////////////////////////////////////////////////////////////////// -type - TDIB = class(TObject) - private - FBitmap : TBitmap; - FPixelFormat : TPixelFormat; - protected - function GetScanline(Row: integer): pointer; virtual; abstract; - constructor Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); - public - property Scanline[Row: integer]: pointer read GetScanline; - property Bitmap: TBitmap read FBitmap; - property PixelFormat: TPixelFormat read FPixelFormat; - end; - - TDIBReader = class(TDIB) - private -{$ifdef VER9x} - FDIB : TDIBSection; - FDC : HDC; - FScanLine : pointer; - FLastRow : integer; - FInfo : PBitmapInfo; - FBytes : integer; -{$endif} - protected - function GetScanline(Row: integer): pointer; override; - public - constructor Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); - destructor Destroy; override; - end; - - TDIBWriter = class(TDIB) - private -{$ifdef PIXELFORMAT_TOO_SLOW} - FDIBInfo : PBitmapInfo; - FDIBBits : pointer; - FDIBInfoSize : integer; - FDIBBitsSize : longInt; -{$ifndef CREATEDIBSECTION_SLOW} - FDIB : HBITMAP; -{$endif} -{$endif} - FPalette : HPalette; - FHeight : integer; - FWidth : integer; - protected - procedure CreateDIB; - procedure FreeDIB; - procedure NeedDIB; - function GetScanline(Row: integer): pointer; override; - public - constructor Create(ABitmap: TBitmap; APixelFormat: TPixelFormat; - AWidth, AHeight: integer; APalette: HPalette); - destructor Destroy; override; - procedure UpdateBitmap; - property Width: integer read FWidth; - property Height: integer read FHeight; - property Palette: HPalette read FPalette; - end; - -//////////////////////////////////////////////////////////////////////////////// -constructor TDIB.Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); -begin - inherited Create; - FBitmap := ABitmap; - FPixelFormat := APixelFormat; -end; - -//////////////////////////////////////////////////////////////////////////////// -constructor TDIBReader.Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); -{$ifdef VER9x} -var - InfoHeaderSize : integer; - ImageSize : longInt; -{$endif} -begin - inherited Create(ABitmap, APixelFormat); -{$ifndef VER9x} - SetPixelFormat(FBitmap, FPixelFormat); -{$else} - FDC := CreateCompatibleDC(0); - SelectPalette(FDC, FBitmap.Palette, False); - - // Allocate DIB info structure - InternalGetDIBSizes(ABitmap.Handle, InfoHeaderSize, ImageSize, APixelFormat); - GetMem(FInfo, InfoHeaderSize); - // Get DIB info - InitializeBitmapInfoHeader(ABitmap.Handle, FInfo^.bmiHeader, APixelFormat); - - // Allocate scan line buffer - GetMem(FScanLine, ImageSize DIV abs(FInfo^.bmiHeader.biHeight)); - - FLastRow := -1; -{$endif} -end; - -destructor TDIBReader.Destroy; -begin -{$ifdef VER9x} - DeleteDC(FDC); - FreeMem(FScanLine); - FreeMem(FInfo); -{$endif} - inherited Destroy; -end; - -function TDIBReader.GetScanline(Row: integer): pointer; -begin -{$ifdef VER9x} - if (Row < 0) or (Row >= FBitmap.Height) then - raise EInvalidGraphicOperation.Create(SScanLine); - GDIFlush; - - Result := FScanLine; - if (Row = FLastRow) then - exit; - FLastRow := Row; - - if (FInfo^.bmiHeader.biHeight > 0) then // bottom-up DIB - Row := FInfo^.bmiHeader.biHeight - Row - 1; - GetDIBits(FDC, FBitmap.Handle, Row, 1, FScanLine, FInfo^, DIB_RGB_COLORS); - -{$else} - Result := FBitmap.ScanLine[Row]; -{$endif} -end; - -//////////////////////////////////////////////////////////////////////////////// -constructor TDIBWriter.Create(ABitmap: TBitmap; APixelFormat: TPixelFormat; - AWidth, AHeight: integer; APalette: HPalette); -begin - inherited Create(ABitmap, APixelFormat); - - // DIB writer only supports 8 or 24 bit bitmaps - if not(APixelFormat in [pf8bit, pf24bit]) then - Error(sInvalidPixelFormat); - if (AWidth = 0) or (AHeight = 0) then - Error(sBadDimension); - - FHeight := AHeight; - FWidth := AWidth; -{$ifndef PIXELFORMAT_TOO_SLOW} - FBitmap.Palette := 0; - FBitmap.Height := FHeight; - FBitmap.Width := FWidth; - SafeSetPixelFormat(FBitmap, FPixelFormat); - FPalette := CopyPalette(APalette); - FBitmap.Palette := FPalette; -{$else} - FPalette := APalette; - FDIBInfo := nil; - FDIBBits := nil; -{$ifndef CREATEDIBSECTION_SLOW} - FDIB := 0; -{$endif} -{$endif} -end; - -destructor TDIBWriter.Destroy; -begin - UpdateBitmap; - FreeDIB; - inherited Destroy; -end; - -function TDIBWriter.GetScanline(Row: integer): pointer; -begin -{$ifdef PIXELFORMAT_TOO_SLOW} - NeedDIB; - - if (FDIBBits = nil) then - Error(sNoDIB); - with FDIBInfo^.bmiHeader do - begin - if (Row < 0) or (Row >= Height) then - raise EInvalidGraphicOperation.Create(SScanLine); - GDIFlush; - - if biHeight > 0 then // bottom-up DIB - Row := biHeight - Row - 1; - Result := PAnsiChar(Cardinal(FDIBBits) + Cardinal(Row) * AlignBit(biWidth, biBitCount, 32)); - end; -{$else} - Result := FBitmap.ScanLine[Row]; -{$endif} -end; - -procedure TDIBWriter.CreateDIB; -{$IFDEF PIXELFORMAT_TOO_SLOW} -var - SrcColors : WORD; -// ScreenDC : HDC; - - // From Delphi 3.02 graphics.pas - // There is a bug in the ByteSwapColors from Delphi 3.0! - procedure ByteSwapColors(var Colors; Count: Integer); - var // convert RGB to BGR and vice-versa. TRGBQuad <-> TPaletteEntry - SysInfo: TSystemInfo; - begin - GetSystemInfo(SysInfo); - asm - MOV EDX, Colors - MOV ECX, Count - DEC ECX - JS @@END - LEA EAX, SysInfo - CMP [EAX].TSystemInfo.wProcessorLevel, 3 - JE @@386 - @@1: MOV EAX, [EDX+ECX*4] - BSWAP EAX - SHR EAX,8 - MOV [EDX+ECX*4],EAX - DEC ECX - JNS @@1 - JMP @@END - @@386: - PUSH EBX - @@2: XOR EBX,EBX - MOV EAX, [EDX+ECX*4] - MOV BH, AL - MOV BL, AH - SHR EAX,16 - SHL EBX,8 - MOV BL, AL - MOV [EDX+ECX*4],EBX - DEC ECX - JNS @@2 - POP EBX - @@END: - end; - end; -{$ENDIF} -begin -{$ifdef PIXELFORMAT_TOO_SLOW} - FreeDIB; - - if (PixelFormat = pf8bit) then - // 8 bit: Header and palette - FDIBInfoSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) * (1 shl 8) - else - // 24 bit: Header but no palette - FDIBInfoSize := SizeOf(TBitmapInfoHeader); - - // Allocate TBitmapInfo structure - GetMem(FDIBInfo, FDIBInfoSize); - try - FDIBInfo^.bmiHeader.biSize := SizeOf(FDIBInfo^.bmiHeader); - FDIBInfo^.bmiHeader.biWidth := Width; - FDIBInfo^.bmiHeader.biHeight := Height; - FDIBInfo^.bmiHeader.biPlanes := 1; - FDIBInfo^.bmiHeader.biSizeImage := 0; - FDIBInfo^.bmiHeader.biCompression := BI_RGB; - - if (PixelFormat = pf8bit) then - begin - FDIBInfo^.bmiHeader.biBitCount := 8; - // Find number of colors defined by palette - if (Palette <> 0) and - (GetObject(Palette, sizeof(SrcColors), @SrcColors) <> 0) and - (SrcColors <> 0) then - begin - // Copy all colors... - GetPaletteEntries(Palette, 0, SrcColors, FDIBInfo^.bmiColors[0]); - // ...and convert BGR to RGB - ByteSwapColors(FDIBInfo^.bmiColors[0], SrcColors); - end else - SrcColors := 0; - - // Finally zero any unused entried - if (SrcColors < 256) then - FillChar(pointer(LongInt(@FDIBInfo^.bmiColors)+SizeOf(TRGBQuad)*SrcColors)^, - 256 - SrcColors, 0); - FDIBInfo^.bmiHeader.biClrUsed := 256; - FDIBInfo^.bmiHeader.biClrImportant := SrcColors; - end else - begin - FDIBInfo^.bmiHeader.biBitCount := 24; - FDIBInfo^.bmiHeader.biClrUsed := 0; - FDIBInfo^.bmiHeader.biClrImportant := 0; - end; - FDIBBitsSize := AlignBit(Width, FDIBInfo^.bmiHeader.biBitCount, 32) * Cardinal(abs(Height)); - -{$ifdef CREATEDIBSECTION_SLOW} - FDIBBits := GlobalAllocPtr(GMEM_MOVEABLE, FDIBBitsSize); - if (FDIBBits = nil) then - raise EOutOfMemory.Create(sOutOfMemDIB); -{$else} -// ScreenDC := GDICheck(GetDC(0)); - try - // Allocate DIB section - // Note: You can ignore warnings about the HDC parameter being 0. The - // parameter is not used for 24 bit bitmaps - FDIB := GDICheck(CreateDIBSection(0 {ScreenDC}, FDIBInfo^, DIB_RGB_COLORS, - FDIBBits, - {$IFDEF VER9x} nil, {$ELSE} 0, {$ENDIF} - 0)); - finally -// ReleaseDC(0, ScreenDC); - end; -{$endif} - - except - FreeDIB; - raise; - end; -{$endif} -end; - -procedure TDIBWriter.FreeDIB; -begin -{$ifdef PIXELFORMAT_TOO_SLOW} - if (FDIBInfo <> nil) then - FreeMem(FDIBInfo); -{$ifdef CREATEDIBSECTION_SLOW} - if (FDIBBits <> nil) then - GlobalFreePtr(FDIBBits); -{$else} - if (FDIB <> 0) then - DeleteObject(FDIB); - FDIB := 0; -{$endif} - FDIBInfo := nil; - FDIBBits := nil; -{$endif} -end; - -procedure TDIBWriter.NeedDIB; -begin -{$ifdef PIXELFORMAT_TOO_SLOW} -{$ifdef CREATEDIBSECTION_SLOW} - if (FDIBBits = nil) then -{$else} - if (FDIB = 0) then -{$endif} - CreateDIB; -{$endif} -end; - -// Convert the DIB created by CreateDIB back to a TBitmap -procedure TDIBWriter.UpdateBitmap; -{$ifdef PIXELFORMAT_TOO_SLOW} -var - Stream : TMemoryStream; - FileSize : longInt; - BitmapFileHeader : TBitmapFileHeader; -{$endif} -begin -{$ifdef PIXELFORMAT_TOO_SLOW} - -{$ifdef CREATEDIBSECTION_SLOW} - if (FDIBBits = nil) then -{$else} - if (FDIB = 0) then -{$endif} - exit; - - // Win95 and NT differs in what solution performs best -{$ifndef CREATEDIBSECTION_SLOW} -{$ifdef VER10_PLUS} - if (Win32Platform = VER_PLATFORM_WIN32_NT) then - begin - // Assign DIB to bitmap - FBitmap.Handle := FDIB; - FDIB := 0; - FBitmap.Palette := CopyPalette(Palette); - end else -{$endif} -{$endif} - begin - // Write DIB to a stream in the BMP file format - Stream := TMemoryStream.Create; - try - // Make room in stream for a TBitmapInfo and pixel data - FileSize := sizeof(TBitmapFileHeader) + FDIBInfoSize + FDIBBitsSize; - Stream.SetSize(FileSize); - // Initialize file header - FillChar(BitmapFileHeader, sizeof(TBitmapFileHeader), 0); - with BitmapFileHeader do - begin - bfType := $4D42; // 'BM' = Windows BMP signature - bfSize := FileSize; // File size (not needed) - bfOffBits := sizeof(TBitmapFileHeader) + FDIBInfoSize; // Offset of pixel data - end; - // Save file header - Stream.Write(BitmapFileHeader, sizeof(TBitmapFileHeader)); - // Save TBitmapInfo structure - Stream.Write(FDIBInfo^, FDIBInfoSize); - // Save pixel data - Stream.Write(FDIBBits^, FDIBBitsSize); - - // Rewind and load bitmap from stream - Stream.Position := 0; - FBitmap.LoadFromStream(Stream); - finally - Stream.Free; - end; - end; -{$endif} -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// Color Mapping -// -//////////////////////////////////////////////////////////////////////////////// -type - TColorLookup = class(TObject) - private - FColors : integer; - public - constructor Create(Palette: hPalette); virtual; - function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; virtual; abstract; - property Colors: integer read FColors; - end; - - PRGBQuadArray = ^TRGBQuadArray; // From Delphi 3 graphics.pas - TRGBQuadArray = array[Byte] of TRGBQuad; // From Delphi 3 graphics.pas - - BGRArray = array[0..0] of TRGBTriple; - PBGRArray = ^BGRArray; - - PalArray = array[byte] of TPaletteEntry; - PPalArray = ^PalArray; - - // TFastColorLookup implements a simple but reasonably fast generic color - // mapper. It trades precision for speed by reducing the size of the color - // space. - // Using a class instead of inline code results in a speed penalty of - // approx. 15% but reduces the complexity of the color reduction routines that - // uses it. If bitmap to GIF conversion speed is really important to you, the - // implementation can easily be inlined again. - TInverseLookup = array[0..1 SHL 15-1] of SmallInt; - PInverseLookup = ^TInverseLookup; - - TFastColorLookup = class(TColorLookup) - private - FPaletteEntries : PPalArray; - FInverseLookup : PInverseLookup; - public - constructor Create(Palette: hPalette); override; - destructor Destroy; override; - function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - end; - - // TSlowColorLookup implements a precise but very slow generic color mapper. - // It uses the GetNearestPaletteIndex GDI function. - // Note: Tests has shown TFastColorLookup to be more precise than - // TSlowColorLookup in many cases. I can't explain why... - TSlowColorLookup = class(TColorLookup) - private - FPaletteEntries : PPalArray; - FPalette : hPalette; - public - constructor Create(Palette: hPalette); override; - destructor Destroy; override; - function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - end; - - // TNetscapeColorLookup maps colors to the netscape 6*6*6 color cube. - TNetscapeColorLookup = class(TColorLookup) - public - constructor Create(Palette: hPalette); override; - function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - end; - - // TGrayWindowsLookup maps colors to 4 shade palette. - TGrayWindowsLookup = class(TSlowColorLookup) - public - constructor Create(Palette: hPalette); override; - function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - end; - - // TGrayScaleLookup maps colors to a uniform 256 shade palette. - TGrayScaleLookup = class(TColorLookup) - public - constructor Create(Palette: hPalette); override; - function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - end; - - // TMonochromeLookup maps colors to a black/white palette. - TMonochromeLookup = class(TColorLookup) - public - constructor Create(Palette: hPalette); override; - function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - end; - -constructor TColorLookup.Create(Palette: hPalette); -begin - inherited Create; -end; - -constructor TFastColorLookup.Create(Palette: hPalette); -var - i : integer; - InverseIndex : integer; -begin - inherited Create(Palette); - - GetMem(FPaletteEntries, sizeof(TPaletteEntry) * 256); - FColors := GetPaletteEntries(Palette, 0, 256, FPaletteEntries^); - - New(FInverseLookup); - for i := low(TInverseLookup) to high(TInverseLookup) do - FInverseLookup^[i] := -1; - - // Premap palette colors - if (FColors > 0) then - for i := 0 to FColors-1 do - with FPaletteEntries^[i] do - begin - InverseIndex := (peRed SHR 3) OR ((peGreen AND $F8) SHL 2) OR ((peBlue AND $F8) SHL 7); - if (FInverseLookup^[InverseIndex] = -1) then - FInverseLookup^[InverseIndex] := i; - end; -end; - -destructor TFastColorLookup.Destroy; -begin - if (FPaletteEntries <> nil) then - FreeMem(FPaletteEntries); - if (FInverseLookup <> nil) then - Dispose(FInverseLookup); - - inherited Destroy; -end; - -// Map color to arbitrary palette -function TFastColorLookup.Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -var - i : integer; - InverseIndex : integer; - Delta , - MinDelta , - MinColor : integer; -begin - // Reduce color space with 3 bits in each dimension - InverseIndex := (Red SHR 3) OR ((Green AND $F8) SHL 2) OR ((Blue AND $F8) SHL 7); - - if (FInverseLookup^[InverseIndex] <> -1) then - Result := AnsiChar(FInverseLookup^[InverseIndex]) - else - begin - // Sequential scan for nearest color to minimize euclidian distance - MinDelta := 3 * (256 * 256); - MinColor := 0; - for i := 0 to FColors-1 do - with FPaletteEntries[i] do - begin - Delta := ABS(peRed - Red) + ABS(peGreen - Green) + ABS(peBlue - Blue); - if (Delta < MinDelta) then - begin - MinDelta := Delta; - MinColor := i; - end; - end; - Result := AnsiChar(MinColor); - FInverseLookup^[InverseIndex] := MinColor; - end; - - with FPaletteEntries^[ord(Result)] do - begin - R := peRed; - G := peGreen; - B := peBlue; - end; -end; - -constructor TSlowColorLookup.Create(Palette: hPalette); -begin - inherited Create(Palette); - FPalette := Palette; - FColors := GetPaletteEntries(Palette, 0, 256, nil^); - if (FColors > 0) then - begin - GetMem(FPaletteEntries, sizeof(TPaletteEntry) * FColors); - FColors := GetPaletteEntries(Palette, 0, 256, FPaletteEntries^); - end; -end; - -destructor TSlowColorLookup.Destroy; -begin - if (FPaletteEntries <> nil) then - FreeMem(FPaletteEntries); - - inherited Destroy; -end; - -// Map color to arbitrary palette -function TSlowColorLookup.Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -begin - Result := AnsiChar(GetNearestPaletteIndex(FPalette, Red OR (Green SHL 8) OR (Blue SHL 16))); - if (FPaletteEntries <> nil) then - with FPaletteEntries^[ord(Result)] do - begin - R := peRed; - G := peGreen; - B := peBlue; - end; -end; - -constructor TNetscapeColorLookup.Create(Palette: hPalette); -begin - inherited Create(Palette); - FColors := 6*6*6; // This better be true or something is wrong -end; - -// Map color to netscape 6*6*6 color cube -function TNetscapeColorLookup.Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -begin - R := (Red+3) DIV 51; - G := (Green+3) DIV 51; - B := (Blue+3) DIV 51; - Result := AnsiChar(B + 6*G + 36*R); - R := R * 51; - G := G * 51; - B := B * 51; -end; - -constructor TGrayWindowsLookup.Create(Palette: hPalette); -begin - inherited Create(Palette); - FColors := 4; -end; - -// Convert color to windows grays -function TGrayWindowsLookup.Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -begin - Result := inherited Lookup(MulDiv(Red, 77, 256), - MulDiv(Green, 150, 256), MulDiv(Blue, 29, 256), R, G, B); -end; - -constructor TGrayScaleLookup.Create(Palette: hPalette); -begin - inherited Create(Palette); - FColors := 256; -end; - -// Convert color to grayscale -function TGrayScaleLookup.Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -begin - Result := AnsiChar((Blue*29 + Green*150 + Red*77) DIV 256); - R := ord(Result); - G := ord(Result); - B := ord(Result); -end; - -constructor TMonochromeLookup.Create(Palette: hPalette); -begin - inherited Create(Palette); - FColors := 2; -end; - -// Convert color to black/white -function TMonochromeLookup.Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -begin - if ((Blue*29 + Green*150 + Red*77) > 32512) then - begin - Result := #1; - R := 255; - G := 255; - B := 255; - end else - begin - Result := #0; - R := 0; - G := 0; - B := 0; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// Dithering engine -// -//////////////////////////////////////////////////////////////////////////////// -type - TDitherEngine = class - private - protected - FDirection : integer; - FColumn : integer; - FLookup : TColorLookup; - Width : integer; - public - constructor Create(AWidth: integer; Lookup: TColorLookup); virtual; - function Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; virtual; - procedure NextLine; virtual; - procedure NextColumn; - - property Direction: integer read FDirection; - property Column: integer read FColumn; - end; - - // Note: TErrorTerm does only *need* to be 16 bits wide, but since - // it is *much* faster to use native machine words (32 bit), we sacrifice - // some bytes (a lot actually) to improve performance. - TErrorTerm = Integer; - TErrors = array[0..0] of TErrorTerm; - PErrors = ^TErrors; - - TFloydSteinbergDitherer = class(TDitherEngine) - private - ErrorsR , - ErrorsG , - ErrorsB : PErrors; - ErrorR , - ErrorG , - ErrorB : PErrors; - CurrentErrorR , // Current error or pixel value - CurrentErrorG , - CurrentErrorB , - BelowErrorR , // Error for pixel below current - BelowErrorG , - BelowErrorB , - BelowPrevErrorR , // Error for pixel below previous pixel - BelowPrevErrorG , - BelowPrevErrorB : TErrorTerm; - public - constructor Create(AWidth: integer; Lookup: TColorLookup); override; - destructor Destroy; override; - function Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - procedure NextLine; override; - end; - - T5by3Ditherer = class(TDitherEngine) - private - ErrorsR0 , - ErrorsG0 , - ErrorsB0 , - ErrorsR1 , - ErrorsG1 , - ErrorsB1 , - ErrorsR2 , - ErrorsG2 , - ErrorsB2 : PErrors; - ErrorR0 , - ErrorG0 , - ErrorB0 , - ErrorR1 , - ErrorG1 , - ErrorB1 , - ErrorR2 , - ErrorG2 , - ErrorB2 : PErrors; - FDirection2 : integer; - protected - FDivisor : integer; - procedure Propagate(Errors0, Errors1, Errors2: PErrors; Error: integer); virtual; abstract; - public - constructor Create(AWidth: integer; Lookup: TColorLookup); override; - destructor Destroy; override; - function Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - procedure NextLine; override; - end; - - TStuckiDitherer = class(T5by3Ditherer) - protected - procedure Propagate(Errors0, Errors1, Errors2: PErrors; Error: integer); override; - public - constructor Create(AWidth: integer; Lookup: TColorLookup); override; - end; - - TSierraDitherer = class(T5by3Ditherer) - protected - procedure Propagate(Errors0, Errors1, Errors2: PErrors; Error: integer); override; - public - constructor Create(AWidth: integer; Lookup: TColorLookup); override; - end; - - TJaJuNiDitherer = class(T5by3Ditherer) - protected - procedure Propagate(Errors0, Errors1, Errors2: PErrors; Error: integer); override; - public - constructor Create(AWidth: integer; Lookup: TColorLookup); override; - end; - - TSteveArcheDitherer = class(TDitherEngine) - private - ErrorsR0 , - ErrorsG0 , - ErrorsB0 , - ErrorsR1 , - ErrorsG1 , - ErrorsB1 , - ErrorsR2 , - ErrorsG2 , - ErrorsB2 , - ErrorsR3 , - ErrorsG3 , - ErrorsB3 : PErrors; - ErrorR0 , - ErrorG0 , - ErrorB0 , - ErrorR1 , - ErrorG1 , - ErrorB1 , - ErrorR2 , - ErrorG2 , - ErrorB2 , - ErrorR3 , - ErrorG3 , - ErrorB3 : PErrors; - FDirection2 , - FDirection3 : integer; - public - constructor Create(AWidth: integer; Lookup: TColorLookup); override; - destructor Destroy; override; - function Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - procedure NextLine; override; - end; - - TBurkesDitherer = class(TDitherEngine) - private - ErrorsR0 , - ErrorsG0 , - ErrorsB0 , - ErrorsR1 , - ErrorsG1 , - ErrorsB1 : PErrors; - ErrorR0 , - ErrorG0 , - ErrorB0 , - ErrorR1 , - ErrorG1 , - ErrorB1 : PErrors; - FDirection2 : integer; - public - constructor Create(AWidth: integer; Lookup: TColorLookup); override; - destructor Destroy; override; - function Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; override; - procedure NextLine; override; - end; - -//////////////////////////////////////////////////////////////////////////////// -// TDitherEngine -constructor TDitherEngine.Create(AWidth: integer; Lookup: TColorLookup); -begin - inherited Create; - - FLookup := Lookup; - Width := AWidth; - - FDirection := 1; - FColumn := 0; -end; - -function TDitherEngine.Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -begin - // Map color to palette - Result := FLookup.Lookup(Red, Green, Blue, R, G, B); - NextColumn; -end; - -procedure TDitherEngine.NextLine; -begin - FDirection := -FDirection; - if (FDirection = 1) then - FColumn := 0 - else - FColumn := Width-1; -end; - -procedure TDitherEngine.NextColumn; -begin - inc(FColumn, FDirection); -end; - -//////////////////////////////////////////////////////////////////////////////// -// TFloydSteinbergDitherer -constructor TFloydSteinbergDitherer.Create(AWidth: integer; Lookup: TColorLookup); -begin - inherited Create(AWidth, Lookup); - - // The Error arrays has (columns + 2) entries; the extra entry at - // each end saves us from special-casing the first and last pixels. - // We can get away with a single array (holding one row's worth of errors) - // by using it to store the current row's errors at pixel columns not yet - // processed, but the next row's errors at columns already processed. We - // need only a few extra variables to hold the errors immediately around the - // current column. (If we are lucky, those variables are in registers, but - // even if not, they're probably cheaper to access than array elements are.) - GetMem(ErrorsR, sizeof(TErrorTerm)*(Width+2)); - GetMem(ErrorsG, sizeof(TErrorTerm)*(Width+2)); - GetMem(ErrorsB, sizeof(TErrorTerm)*(Width+2)); - FillChar(ErrorsR^, sizeof(TErrorTerm)*(Width+2), 0); - FillChar(ErrorsG^, sizeof(TErrorTerm)*(Width+2), 0); - FillChar(ErrorsB^, sizeof(TErrorTerm)*(Width+2), 0); - ErrorR := ErrorsR; - ErrorG := ErrorsG; - ErrorB := ErrorsB; - CurrentErrorR := 0; - CurrentErrorG := CurrentErrorR; - CurrentErrorB := CurrentErrorR; - BelowErrorR := CurrentErrorR; - BelowErrorG := CurrentErrorR; - BelowErrorB := CurrentErrorR; - BelowPrevErrorR := CurrentErrorR; - BelowPrevErrorG := CurrentErrorR; - BelowPrevErrorB := CurrentErrorR; -end; - -destructor TFloydSteinbergDitherer.Destroy; -begin - FreeMem(ErrorsR); - FreeMem(ErrorsG); - FreeMem(ErrorsB); - inherited Destroy; -end; - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -function TFloydSteinbergDitherer.Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -var - BelowNextError : TErrorTerm; - Delta : TErrorTerm; -begin - CurrentErrorR := Red + (CurrentErrorR + ErrorR[0] + 8) DIV 16; -// CurrentErrorR := Red + (CurrentErrorR + ErrorR[Direction] + 8) DIV 16; - if (CurrentErrorR < 0) then - CurrentErrorR := 0 - else if (CurrentErrorR > 255) then - CurrentErrorR := 255; - - CurrentErrorG := Green + (CurrentErrorG + ErrorG[0] + 8) DIV 16; -// CurrentErrorG := Green + (CurrentErrorG + ErrorG[Direction] + 8) DIV 16; - if (CurrentErrorG < 0) then - CurrentErrorG := 0 - else if (CurrentErrorG > 255) then - CurrentErrorG := 255; - - CurrentErrorB := Blue + (CurrentErrorB + ErrorB[0] + 8) DIV 16; -// CurrentErrorB := Blue + (CurrentErrorB + ErrorB[Direction] + 8) DIV 16; - if (CurrentErrorB < 0) then - CurrentErrorB := 0 - else if (CurrentErrorB > 255) then - CurrentErrorB := 255; - - // Map color to palette - Result := inherited Dither(CurrentErrorR, CurrentErrorG, CurrentErrorB, R, G, B); - - // Propagate Floyd-Steinberg error terms. - // Errors are accumulated into the error arrays, at a resolution of - // 1/16th of a pixel count. The error at a given pixel is propagated - // to its not-yet-processed neighbors using the standard F-S fractions, - // ... (here) 7/16 - // 3/16 5/16 1/16 - // We work left-to-right on even rows, right-to-left on odd rows. - - // Red component - CurrentErrorR := CurrentErrorR - R; - if (CurrentErrorR <> 0) then - begin - BelowNextError := CurrentErrorR; // Error * 1 - - Delta := CurrentErrorR * 2; - inc(CurrentErrorR, Delta); - ErrorR[0] := BelowPrevErrorR + CurrentErrorR; // Error * 3 - - inc(CurrentErrorR, Delta); - BelowPrevErrorR := BelowErrorR + CurrentErrorR; // Error * 5 - - BelowErrorR := BelowNextError; // Error * 1 - - inc(CurrentErrorR, Delta); // Error * 7 - end; - - // Green component - CurrentErrorG := CurrentErrorG - G; - if (CurrentErrorG <> 0) then - begin - BelowNextError := CurrentErrorG; // Error * 1 - - Delta := CurrentErrorG * 2; - inc(CurrentErrorG, Delta); - ErrorG[0] := BelowPrevErrorG + CurrentErrorG; // Error * 3 - - inc(CurrentErrorG, Delta); - BelowPrevErrorG := BelowErrorG + CurrentErrorG; // Error * 5 - - BelowErrorG := BelowNextError; // Error * 1 - - inc(CurrentErrorG, Delta); // Error * 7 - end; - - // Blue component - CurrentErrorB := CurrentErrorB - B; - if (CurrentErrorB <> 0) then - begin - BelowNextError := CurrentErrorB; // Error * 1 - - Delta := CurrentErrorB * 2; - inc(CurrentErrorB, Delta); - ErrorB[0] := BelowPrevErrorB + CurrentErrorB; // Error * 3 - - inc(CurrentErrorB, Delta); - BelowPrevErrorB := BelowErrorB + CurrentErrorB; // Error * 5 - - BelowErrorB := BelowNextError; // Error * 1 - - inc(CurrentErrorB, Delta); // Error * 7 - end; - - // Move on to next column - if (Direction = 1) then - begin - inc(longInt(ErrorR), sizeof(TErrorTerm)); - inc(longInt(ErrorG), sizeof(TErrorTerm)); - inc(longInt(ErrorB), sizeof(TErrorTerm)); - end else - begin - dec(longInt(ErrorR), sizeof(TErrorTerm)); - dec(longInt(ErrorG), sizeof(TErrorTerm)); - dec(longInt(ErrorB), sizeof(TErrorTerm)); - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -procedure TFloydSteinbergDitherer.NextLine; -begin - ErrorR[0] := BelowPrevErrorR; - ErrorG[0] := BelowPrevErrorG; - ErrorB[0] := BelowPrevErrorB; - - // Note: The optimizer produces better code for this construct: - // a := 0; b := a; c := a; - // compared to this construct: - // a := 0; b := 0; c := 0; - CurrentErrorR := 0; - CurrentErrorG := CurrentErrorR; - CurrentErrorB := CurrentErrorG; - BelowErrorR := CurrentErrorG; - BelowErrorG := CurrentErrorG; - BelowErrorB := CurrentErrorG; - BelowPrevErrorR := CurrentErrorG; - BelowPrevErrorG := CurrentErrorG; - BelowPrevErrorB := CurrentErrorG; - - inherited NextLine; - - if (Direction = 1) then - begin - ErrorR := ErrorsR; - ErrorG := ErrorsG; - ErrorB := ErrorsB; - end else - begin - ErrorR := @ErrorsR[Width+1]; - ErrorG := @ErrorsG[Width+1]; - ErrorB := @ErrorsB[Width+1]; - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// T5by3Ditherer -constructor T5by3Ditherer.Create(AWidth: integer; Lookup: TColorLookup); -begin - inherited Create(AWidth, Lookup); - - GetMem(ErrorsR0, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsG0, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsB0, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsR1, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsG1, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsB1, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsR2, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsG2, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsB2, sizeof(TErrorTerm)*(Width+4)); - FillChar(ErrorsR0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsG0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsB0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsR1^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsG1^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsB1^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsR2^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsG2^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsB2^, sizeof(TErrorTerm)*(Width+4), 0); - - FDivisor := 1; - FDirection2 := 2 * Direction; - ErrorR0 := PErrors(longInt(ErrorsR0)+2*sizeof(TErrorTerm)); - ErrorG0 := PErrors(longInt(ErrorsG0)+2*sizeof(TErrorTerm)); - ErrorB0 := PErrors(longInt(ErrorsB0)+2*sizeof(TErrorTerm)); - ErrorR1 := PErrors(longInt(ErrorsR1)+2*sizeof(TErrorTerm)); - ErrorG1 := PErrors(longInt(ErrorsG1)+2*sizeof(TErrorTerm)); - ErrorB1 := PErrors(longInt(ErrorsB1)+2*sizeof(TErrorTerm)); - ErrorR2 := PErrors(longInt(ErrorsR2)+2*sizeof(TErrorTerm)); - ErrorG2 := PErrors(longInt(ErrorsG2)+2*sizeof(TErrorTerm)); - ErrorB2 := PErrors(longInt(ErrorsB2)+2*sizeof(TErrorTerm)); -end; - -destructor T5by3Ditherer.Destroy; -begin - FreeMem(ErrorsR0); - FreeMem(ErrorsG0); - FreeMem(ErrorsB0); - FreeMem(ErrorsR1); - FreeMem(ErrorsG1); - FreeMem(ErrorsB1); - FreeMem(ErrorsR2); - FreeMem(ErrorsG2); - FreeMem(ErrorsB2); - inherited Destroy; -end; - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -function T5by3Ditherer.Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -var - ColorR , - ColorG , - ColorB : integer; // Error for current pixel -begin - // Apply red component error correction - ColorR := Red + (ErrorR0[0] + FDivisor DIV 2) DIV FDivisor; - if (ColorR < 0) then - ColorR := 0 - else if (ColorR > 255) then - ColorR := 255; - - // Apply green component error correction - ColorG := Green + (ErrorG0[0] + FDivisor DIV 2) DIV FDivisor; - if (ColorG < 0) then - ColorG := 0 - else if (ColorG > 255) then - ColorG := 255; - - // Apply blue component error correction - ColorB := Blue + (ErrorB0[0] + FDivisor DIV 2) DIV FDivisor; - if (ColorB < 0) then - ColorB := 0 - else if (ColorB > 255) then - ColorB := 255; - - // Map color to palette - Result := inherited Dither(ColorR, ColorG, ColorB, R, G, B); - - // Propagate red component error - Propagate(ErrorR0, ErrorR1, ErrorR2, ColorR - R); - // Propagate green component error - Propagate(ErrorG0, ErrorG1, ErrorG2, ColorG - G); - // Propagate blue component error - Propagate(ErrorB0, ErrorB1, ErrorB2, ColorB - B); - - // Move on to next column - if (Direction = 1) then - begin - inc(longInt(ErrorR0), sizeof(TErrorTerm)); - inc(longInt(ErrorG0), sizeof(TErrorTerm)); - inc(longInt(ErrorB0), sizeof(TErrorTerm)); - inc(longInt(ErrorR1), sizeof(TErrorTerm)); - inc(longInt(ErrorG1), sizeof(TErrorTerm)); - inc(longInt(ErrorB1), sizeof(TErrorTerm)); - inc(longInt(ErrorR2), sizeof(TErrorTerm)); - inc(longInt(ErrorG2), sizeof(TErrorTerm)); - inc(longInt(ErrorB2), sizeof(TErrorTerm)); - end else - begin - dec(longInt(ErrorR0), sizeof(TErrorTerm)); - dec(longInt(ErrorG0), sizeof(TErrorTerm)); - dec(longInt(ErrorB0), sizeof(TErrorTerm)); - dec(longInt(ErrorR1), sizeof(TErrorTerm)); - dec(longInt(ErrorG1), sizeof(TErrorTerm)); - dec(longInt(ErrorB1), sizeof(TErrorTerm)); - dec(longInt(ErrorR2), sizeof(TErrorTerm)); - dec(longInt(ErrorG2), sizeof(TErrorTerm)); - dec(longInt(ErrorB2), sizeof(TErrorTerm)); - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -procedure T5by3Ditherer.NextLine; -var - TempErrors : PErrors; -begin - FillChar(ErrorsR0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsG0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsB0^, sizeof(TErrorTerm)*(Width+4), 0); - - // Swap lines - TempErrors := ErrorsR0; - ErrorsR0 := ErrorsR1; - ErrorsR1 := ErrorsR2; - ErrorsR2 := TempErrors; - - TempErrors := ErrorsG0; - ErrorsG0 := ErrorsG1; - ErrorsG1 := ErrorsG2; - ErrorsG2 := TempErrors; - - TempErrors := ErrorsB0; - ErrorsB0 := ErrorsB1; - ErrorsB1 := ErrorsB2; - ErrorsB2 := TempErrors; - - inherited NextLine; - - FDirection2 := 2 * Direction; - if (Direction = 1) then - begin - // ErrorsR0[1] gives compiler error, so we - // use PErrors(longInt(ErrorsR0)+sizeof(TErrorTerm)) instead... - ErrorR0 := PErrors(longInt(ErrorsR0)+2*sizeof(TErrorTerm)); - ErrorG0 := PErrors(longInt(ErrorsG0)+2*sizeof(TErrorTerm)); - ErrorB0 := PErrors(longInt(ErrorsB0)+2*sizeof(TErrorTerm)); - ErrorR1 := PErrors(longInt(ErrorsR1)+2*sizeof(TErrorTerm)); - ErrorG1 := PErrors(longInt(ErrorsG1)+2*sizeof(TErrorTerm)); - ErrorB1 := PErrors(longInt(ErrorsB1)+2*sizeof(TErrorTerm)); - ErrorR2 := PErrors(longInt(ErrorsR2)+2*sizeof(TErrorTerm)); - ErrorG2 := PErrors(longInt(ErrorsG2)+2*sizeof(TErrorTerm)); - ErrorB2 := PErrors(longInt(ErrorsB2)+2*sizeof(TErrorTerm)); - end else - begin - ErrorR0 := @ErrorsR0[Width+1]; - ErrorG0 := @ErrorsG0[Width+1]; - ErrorB0 := @ErrorsB0[Width+1]; - ErrorR1 := @ErrorsR1[Width+1]; - ErrorG1 := @ErrorsG1[Width+1]; - ErrorB1 := @ErrorsB1[Width+1]; - ErrorR2 := @ErrorsR2[Width+1]; - ErrorG2 := @ErrorsG2[Width+1]; - ErrorB2 := @ErrorsB2[Width+1]; - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// TStuckiDitherer -constructor TStuckiDitherer.Create(AWidth: integer; Lookup: TColorLookup); -begin - inherited Create(AWidth, Lookup); - FDivisor := 42; -end; - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -procedure TStuckiDitherer.Propagate(Errors0, Errors1, Errors2: PErrors; Error: integer); -begin - if (Error = 0) then - exit; - // Propagate Stucki error terms: - // ... ... (here) 8/42 4/42 - // 2/42 4/42 8/42 4/42 2/42 - // 1/42 2/42 4/42 2/42 1/42 - inc(Errors2[FDirection2], Error); // Error * 1 - inc(Errors2[-FDirection2], Error); // Error * 1 - - Error := Error + Error; - inc(Errors1[FDirection2], Error); // Error * 2 - inc(Errors1[-FDirection2], Error); // Error * 2 - inc(Errors2[Direction], Error); // Error * 2 - inc(Errors2[-Direction], Error); // Error * 2 - - Error := Error + Error; - inc(Errors0[FDirection2], Error); // Error * 4 - inc(Errors1[-Direction], Error); // Error * 4 - inc(Errors1[Direction], Error); // Error * 4 - inc(Errors2[0], Error); // Error * 4 - - Error := Error + Error; - inc(Errors0[Direction], Error); // Error * 8 - inc(Errors1[0], Error); // Error * 8 -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// TSierraDitherer -constructor TSierraDitherer.Create(AWidth: integer; Lookup: TColorLookup); -begin - inherited Create(AWidth, Lookup); - FDivisor := 32; -end; - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -procedure TSierraDitherer.Propagate(Errors0, Errors1, Errors2: PErrors; Error: integer); -var - TempError : integer; -begin - if (Error = 0) then - exit; - // Propagate Sierra error terms: - // ... ... (here) 5/32 3/32 - // 2/32 4/32 5/32 4/32 2/32 - // ... 2/32 3/32 2/32 ... - TempError := Error + Error; - inc(Errors1[FDirection2], TempError); // Error * 2 - inc(Errors1[-FDirection2], TempError);// Error * 2 - inc(Errors2[Direction], TempError); // Error * 2 - inc(Errors2[-Direction], TempError); // Error * 2 - - inc(TempError, Error); - inc(Errors0[FDirection2], TempError); // Error * 3 - inc(Errors2[0], TempError); // Error * 3 - - inc(TempError, Error); - inc(Errors1[-Direction], TempError); // Error * 4 - inc(Errors1[Direction], TempError); // Error * 4 - - inc(TempError, Error); - inc(Errors0[Direction], TempError); // Error * 5 - inc(Errors1[0], TempError); // Error * 5 -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// TJaJuNiDitherer -constructor TJaJuNiDitherer.Create(AWidth: integer; Lookup: TColorLookup); -begin - inherited Create(AWidth, Lookup); - FDivisor := 38; -end; - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -procedure TJaJuNiDitherer.Propagate(Errors0, Errors1, Errors2: PErrors; Error: integer); -var - TempError : integer; -begin - if (Error = 0) then - exit; - // Propagate Jarvis, Judice and Ninke error terms: - // ... ... (here) 8/38 4/38 - // 2/38 4/38 8/38 4/38 2/38 - // 1/38 2/38 4/38 2/38 1/38 - inc(Errors2[FDirection2], Error); // Error * 1 - inc(Errors2[-FDirection2], Error); // Error * 1 - - TempError := Error + Error; - inc(Error, TempError); - inc(Errors1[FDirection2], Error); // Error * 3 - inc(Errors1[-FDirection2], Error); // Error * 3 - inc(Errors2[Direction], Error); // Error * 3 - inc(Errors2[-Direction], Error); // Error * 3 - - inc(Error, TempError); - inc(Errors0[FDirection2], Error); // Error * 5 - inc(Errors1[-Direction], Error); // Error * 5 - inc(Errors1[Direction], Error); // Error * 5 - inc(Errors2[0], Error); // Error * 5 - - inc(Error, TempError); - inc(Errors0[Direction], Error); // Error * 7 - inc(Errors1[0], Error); // Error * 7 -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// TSteveArcheDitherer -constructor TSteveArcheDitherer.Create(AWidth: integer; Lookup: TColorLookup); -begin - inherited Create(AWidth, Lookup); - - GetMem(ErrorsR0, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsG0, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsB0, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsR1, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsG1, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsB1, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsR2, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsG2, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsB2, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsR3, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsG3, sizeof(TErrorTerm)*(Width+6)); - GetMem(ErrorsB3, sizeof(TErrorTerm)*(Width+6)); - FillChar(ErrorsR0^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsG0^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsB0^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsR1^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsG1^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsB1^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsR2^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsG2^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsB2^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsR3^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsG3^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsB3^, sizeof(TErrorTerm)*(Width+6), 0); - - FDirection2 := 2 * Direction; - FDirection3 := 3 * Direction; - - ErrorR0 := PErrors(longInt(ErrorsR0)+3*sizeof(TErrorTerm)); - ErrorG0 := PErrors(longInt(ErrorsG0)+3*sizeof(TErrorTerm)); - ErrorB0 := PErrors(longInt(ErrorsB0)+3*sizeof(TErrorTerm)); - ErrorR1 := PErrors(longInt(ErrorsR1)+3*sizeof(TErrorTerm)); - ErrorG1 := PErrors(longInt(ErrorsG1)+3*sizeof(TErrorTerm)); - ErrorB1 := PErrors(longInt(ErrorsB1)+3*sizeof(TErrorTerm)); - ErrorR2 := PErrors(longInt(ErrorsR2)+3*sizeof(TErrorTerm)); - ErrorG2 := PErrors(longInt(ErrorsG2)+3*sizeof(TErrorTerm)); - ErrorB2 := PErrors(longInt(ErrorsB2)+3*sizeof(TErrorTerm)); - ErrorR3 := PErrors(longInt(ErrorsR3)+3*sizeof(TErrorTerm)); - ErrorG3 := PErrors(longInt(ErrorsG3)+3*sizeof(TErrorTerm)); - ErrorB3 := PErrors(longInt(ErrorsB3)+3*sizeof(TErrorTerm)); -end; - -destructor TSteveArcheDitherer.Destroy; -begin - FreeMem(ErrorsR0); - FreeMem(ErrorsG0); - FreeMem(ErrorsB0); - FreeMem(ErrorsR1); - FreeMem(ErrorsG1); - FreeMem(ErrorsB1); - FreeMem(ErrorsR2); - FreeMem(ErrorsG2); - FreeMem(ErrorsB2); - FreeMem(ErrorsR3); - FreeMem(ErrorsG3); - FreeMem(ErrorsB3); - inherited Destroy; -end; - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -function TSteveArcheDitherer.Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -var - ColorR , - ColorG , - ColorB : integer; // Error for current pixel - - // Propagate Stevenson & Arche error terms: - // ... ... ... (here) ... 32/200 ... - // 12/200 ... 26/200 ... 30/200 ... 16/200 - // ... 12/200 ... 26/200 ... 12/200 ... - // 5/200 ... 12/200 ... 12/200 ... 5/200 - procedure Propagate(Errors0, Errors1, Errors2, Errors3: PErrors; Error: integer); - var - TempError : integer; - begin - if (Error = 0) then - exit; - TempError := 5 * Error; - inc(Errors3[FDirection3], TempError); // Error * 5 - inc(Errors3[-FDirection3], TempError); // Error * 5 - - TempError := 12 * Error; - inc(Errors1[-FDirection3], TempError); // Error * 12 - inc(Errors2[-FDirection2], TempError); // Error * 12 - inc(Errors2[FDirection2], TempError); // Error * 12 - inc(Errors3[-Direction], TempError); // Error * 12 - inc(Errors3[Direction], TempError); // Error * 12 - - inc(Errors1[FDirection3], 16 * TempError); // Error * 16 - - TempError := 26 * Error; - inc(Errors1[-Direction], TempError); // Error * 26 - inc(Errors2[0], TempError); // Error * 26 - - inc(Errors1[Direction], 30 * Error); // Error * 30 - - inc(Errors0[FDirection2], 32 * Error); // Error * 32 - end; - -begin - // Apply red component error correction - ColorR := Red + (ErrorR0[0] + 100) DIV 200; - if (ColorR < 0) then - ColorR := 0 - else if (ColorR > 255) then - ColorR := 255; - - // Apply green component error correction - ColorG := Green + (ErrorG0[0] + 100) DIV 200; - if (ColorG < 0) then - ColorG := 0 - else if (ColorG > 255) then - ColorG := 255; - - // Apply blue component error correction - ColorB := Blue + (ErrorB0[0] + 100) DIV 200; - if (ColorB < 0) then - ColorB := 0 - else if (ColorB > 255) then - ColorB := 255; - - // Map color to palette - Result := inherited Dither(ColorR, ColorG, ColorB, R, G, B); - - // Propagate red component error - Propagate(ErrorR0, ErrorR1, ErrorR2, ErrorR3, ColorR - R); - // Propagate green component error - Propagate(ErrorG0, ErrorG1, ErrorG2, ErrorG3, ColorG - G); - // Propagate blue component error - Propagate(ErrorB0, ErrorB1, ErrorB2, ErrorB3, ColorB - B); - - // Move on to next column - if (Direction = 1) then - begin - inc(longInt(ErrorR0), sizeof(TErrorTerm)); - inc(longInt(ErrorG0), sizeof(TErrorTerm)); - inc(longInt(ErrorB0), sizeof(TErrorTerm)); - inc(longInt(ErrorR1), sizeof(TErrorTerm)); - inc(longInt(ErrorG1), sizeof(TErrorTerm)); - inc(longInt(ErrorB1), sizeof(TErrorTerm)); - inc(longInt(ErrorR2), sizeof(TErrorTerm)); - inc(longInt(ErrorG2), sizeof(TErrorTerm)); - inc(longInt(ErrorB2), sizeof(TErrorTerm)); - inc(longInt(ErrorR3), sizeof(TErrorTerm)); - inc(longInt(ErrorG3), sizeof(TErrorTerm)); - inc(longInt(ErrorB3), sizeof(TErrorTerm)); - end else - begin - dec(longInt(ErrorR0), sizeof(TErrorTerm)); - dec(longInt(ErrorG0), sizeof(TErrorTerm)); - dec(longInt(ErrorB0), sizeof(TErrorTerm)); - dec(longInt(ErrorR1), sizeof(TErrorTerm)); - dec(longInt(ErrorG1), sizeof(TErrorTerm)); - dec(longInt(ErrorB1), sizeof(TErrorTerm)); - dec(longInt(ErrorR2), sizeof(TErrorTerm)); - dec(longInt(ErrorG2), sizeof(TErrorTerm)); - dec(longInt(ErrorB2), sizeof(TErrorTerm)); - dec(longInt(ErrorR3), sizeof(TErrorTerm)); - dec(longInt(ErrorG3), sizeof(TErrorTerm)); - dec(longInt(ErrorB3), sizeof(TErrorTerm)); - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -procedure TSteveArcheDitherer.NextLine; -var - TempErrors : PErrors; -begin - FillChar(ErrorsR0^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsG0^, sizeof(TErrorTerm)*(Width+6), 0); - FillChar(ErrorsB0^, sizeof(TErrorTerm)*(Width+6), 0); - - // Swap lines - TempErrors := ErrorsR0; - ErrorsR0 := ErrorsR1; - ErrorsR1 := ErrorsR2; - ErrorsR2 := ErrorsR3; - ErrorsR3 := TempErrors; - - TempErrors := ErrorsG0; - ErrorsG0 := ErrorsG1; - ErrorsG1 := ErrorsG2; - ErrorsG2 := ErrorsG3; - ErrorsG3 := TempErrors; - - TempErrors := ErrorsB0; - ErrorsB0 := ErrorsB1; - ErrorsB1 := ErrorsB2; - ErrorsB2 := ErrorsB3; - ErrorsB3 := TempErrors; - - inherited NextLine; - - FDirection2 := 2 * Direction; - FDirection3 := 3 * Direction; - - if (Direction = 1) then - begin - // ErrorsR0[1] gives compiler error, so we - // use PErrors(longInt(ErrorsR0)+sizeof(TErrorTerm)) instead... - ErrorR0 := PErrors(longInt(ErrorsR0)+3*sizeof(TErrorTerm)); - ErrorG0 := PErrors(longInt(ErrorsG0)+3*sizeof(TErrorTerm)); - ErrorB0 := PErrors(longInt(ErrorsB0)+3*sizeof(TErrorTerm)); - ErrorR1 := PErrors(longInt(ErrorsR1)+3*sizeof(TErrorTerm)); - ErrorG1 := PErrors(longInt(ErrorsG1)+3*sizeof(TErrorTerm)); - ErrorB1 := PErrors(longInt(ErrorsB1)+3*sizeof(TErrorTerm)); - ErrorR2 := PErrors(longInt(ErrorsR2)+3*sizeof(TErrorTerm)); - ErrorG2 := PErrors(longInt(ErrorsG2)+3*sizeof(TErrorTerm)); - ErrorB2 := PErrors(longInt(ErrorsB2)+3*sizeof(TErrorTerm)); - ErrorR3 := PErrors(longInt(ErrorsR3)+3*sizeof(TErrorTerm)); - ErrorG3 := PErrors(longInt(ErrorsG3)+3*sizeof(TErrorTerm)); - ErrorB3 := PErrors(longInt(ErrorsB3)+3*sizeof(TErrorTerm)); - end else - begin - ErrorR0 := @ErrorsR0[Width+2]; - ErrorG0 := @ErrorsG0[Width+2]; - ErrorB0 := @ErrorsB0[Width+2]; - ErrorR1 := @ErrorsR1[Width+2]; - ErrorG1 := @ErrorsG1[Width+2]; - ErrorB1 := @ErrorsB1[Width+2]; - ErrorR2 := @ErrorsR2[Width+2]; - ErrorG2 := @ErrorsG2[Width+2]; - ErrorB2 := @ErrorsB2[Width+2]; - ErrorR3 := @ErrorsR2[Width+2]; - ErrorG3 := @ErrorsG2[Width+2]; - ErrorB3 := @ErrorsB2[Width+2]; - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// TBurkesDitherer -constructor TBurkesDitherer.Create(AWidth: integer; Lookup: TColorLookup); -begin - inherited Create(AWidth, Lookup); - - GetMem(ErrorsR0, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsG0, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsB0, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsR1, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsG1, sizeof(TErrorTerm)*(Width+4)); - GetMem(ErrorsB1, sizeof(TErrorTerm)*(Width+4)); - FillChar(ErrorsR0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsG0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsB0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsR1^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsG1^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsB1^, sizeof(TErrorTerm)*(Width+4), 0); - - FDirection2 := 2 * Direction; - ErrorR0 := PErrors(longInt(ErrorsR0)+2*sizeof(TErrorTerm)); - ErrorG0 := PErrors(longInt(ErrorsG0)+2*sizeof(TErrorTerm)); - ErrorB0 := PErrors(longInt(ErrorsB0)+2*sizeof(TErrorTerm)); - ErrorR1 := PErrors(longInt(ErrorsR1)+2*sizeof(TErrorTerm)); - ErrorG1 := PErrors(longInt(ErrorsG1)+2*sizeof(TErrorTerm)); - ErrorB1 := PErrors(longInt(ErrorsB1)+2*sizeof(TErrorTerm)); -end; - -destructor TBurkesDitherer.Destroy; -begin - FreeMem(ErrorsR0); - FreeMem(ErrorsG0); - FreeMem(ErrorsB0); - FreeMem(ErrorsR1); - FreeMem(ErrorsG1); - FreeMem(ErrorsB1); - inherited Destroy; -end; - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -function TBurkesDitherer.Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): AnsiChar; -var - ErrorR , - ErrorG , - ErrorB : integer; // Error for current pixel - - // Propagate Burkes error terms: - // ... ... (here) 8/32 4/32 - // 2/32 4/32 8/32 4/32 2/32 - procedure Propagate(Errors0, Errors1: PErrors; Error: integer); - begin - if (Error = 0) then - exit; - inc(Error, Error); - inc(Errors1[FDirection2], Error); // Error * 2 - inc(Errors1[-FDirection2], Error); // Error * 2 - - inc(Error, Error); - inc(Errors0[FDirection2], Error); // Error * 4 - inc(Errors1[-Direction], Error); // Error * 4 - inc(Errors1[Direction], Error); // Error * 4 - - inc(Error, Error); - inc(Errors0[Direction], Error); // Error * 8 - inc(Errors1[0], Error); // Error * 8 - end; - -begin - // Apply red component error correction - ErrorR := Red + (ErrorR0[0] + 16) DIV 32; - if (ErrorR < 0) then - ErrorR := 0 - else if (ErrorR > 255) then - ErrorR := 255; - - // Apply green component error correction - ErrorG := Green + (ErrorG0[0] + 16) DIV 32; - if (ErrorG < 0) then - ErrorG := 0 - else if (ErrorG > 255) then - ErrorG := 255; - - // Apply blue component error correction - ErrorB := Blue + (ErrorB0[0] + 16) DIV 32; - if (ErrorB < 0) then - ErrorB := 0 - else if (ErrorB > 255) then - ErrorB := 255; - - // Map color to palette - Result := inherited Dither(ErrorR, ErrorG, ErrorB, R, G, B); - - // Propagate red component error - Propagate(ErrorR0, ErrorR1, ErrorR - R); - // Propagate green component error - Propagate(ErrorG0, ErrorG1, ErrorG - G); - // Propagate blue component error - Propagate(ErrorB0, ErrorB1, ErrorB - B); - - // Move on to next column - if (Direction = 1) then - begin - inc(longInt(ErrorR0), sizeof(TErrorTerm)); - inc(longInt(ErrorG0), sizeof(TErrorTerm)); - inc(longInt(ErrorB0), sizeof(TErrorTerm)); - inc(longInt(ErrorR1), sizeof(TErrorTerm)); - inc(longInt(ErrorG1), sizeof(TErrorTerm)); - inc(longInt(ErrorB1), sizeof(TErrorTerm)); - end else - begin - dec(longInt(ErrorR0), sizeof(TErrorTerm)); - dec(longInt(ErrorG0), sizeof(TErrorTerm)); - dec(longInt(ErrorB0), sizeof(TErrorTerm)); - dec(longInt(ErrorR1), sizeof(TErrorTerm)); - dec(longInt(ErrorG1), sizeof(TErrorTerm)); - dec(longInt(ErrorB1), sizeof(TErrorTerm)); - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -procedure TBurkesDitherer.NextLine; -var - TempErrors : PErrors; -begin - FillChar(ErrorsR0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsG0^, sizeof(TErrorTerm)*(Width+4), 0); - FillChar(ErrorsB0^, sizeof(TErrorTerm)*(Width+4), 0); - - // Swap lines - TempErrors := ErrorsR0; - ErrorsR0 := ErrorsR1; - ErrorsR1 := TempErrors; - - TempErrors := ErrorsG0; - ErrorsG0 := ErrorsG1; - ErrorsG1 := TempErrors; - - TempErrors := ErrorsB0; - ErrorsB0 := ErrorsB1; - ErrorsB1 := TempErrors; - - inherited NextLine; - - FDirection2 := 2 * Direction; - if (Direction = 1) then - begin - // ErrorsR0[1] gives compiler error, so we - // use PErrors(longInt(ErrorsR0)+sizeof(TErrorTerm)) instead... - ErrorR0 := PErrors(longInt(ErrorsR0)+2*sizeof(TErrorTerm)); - ErrorG0 := PErrors(longInt(ErrorsG0)+2*sizeof(TErrorTerm)); - ErrorB0 := PErrors(longInt(ErrorsB0)+2*sizeof(TErrorTerm)); - ErrorR1 := PErrors(longInt(ErrorsR1)+2*sizeof(TErrorTerm)); - ErrorG1 := PErrors(longInt(ErrorsG1)+2*sizeof(TErrorTerm)); - ErrorB1 := PErrors(longInt(ErrorsB1)+2*sizeof(TErrorTerm)); - end else - begin - ErrorR0 := @ErrorsR0[Width+1]; - ErrorG0 := @ErrorsG0[Width+1]; - ErrorB0 := @ErrorsB0[Width+1]; - ErrorR1 := @ErrorsR1[Width+1]; - ErrorG1 := @ErrorsG1[Width+1]; - ErrorB1 := @ErrorsB1[Width+1]; - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// -// Octree Color Quantization Engine -// -//////////////////////////////////////////////////////////////////////////////// -// Adapted from Earl F. Glynn's ColorQuantizationLibrary, March 1998 -//////////////////////////////////////////////////////////////////////////////// -type - TOctreeNode = class; // Forward definition so TReducibleNodes can be declared - - TReducibleNodes = array[0..7] of TOctreeNode; - - TOctreeNode = Class(TObject) - public - IsLeaf : Boolean; - PixelCount : integer; - RedSum : integer; - GreenSum : integer; - BlueSum : integer; - Next : TOctreeNode; - Child : TReducibleNodes; - - constructor Create(Level: integer; ColorBits: integer; var LeafCount: integer; - var ReducibleNodes: TReducibleNodes); - destructor Destroy; override; - end; - - TColorQuantizer = class(TObject) - private - FTree : TOctreeNode; - FLeafCount : integer; - FReducibleNodes : TReducibleNodes; - FMaxColors : integer; - FColorBits : integer; - - protected - procedure AddColor(var Node: TOctreeNode; r, g, b: byte; ColorBits: integer; - Level: integer; var LeafCount: integer; var ReducibleNodes: TReducibleNodes); - procedure DeleteTree(var Node: TOctreeNode); - procedure GetPaletteColors(const Node: TOctreeNode; - var RGBQuadArray: TRGBQuadArray; var Index: integer); - procedure ReduceTree(ColorBits: integer; var LeafCount: integer; - var ReducibleNodes: TReducibleNodes); - - public - constructor Create(MaxColors: integer; ColorBits: integer); - destructor Destroy; override; - - procedure GetColorTable(var RGBQuadArray: TRGBQuadArray); - function ProcessImage(const DIB: TDIBReader): boolean; - - property ColorCount: integer read FLeafCount; - end; - -constructor TOctreeNode.Create(Level: integer; ColorBits: integer; - var LeafCount: integer; var ReducibleNodes: TReducibleNodes); -var - i : integer; -begin - PixelCount := 0; - RedSum := 0; - GreenSum := 0; - BlueSum := 0; - for i := Low(Child) to High(Child) do - Child[i] := nil; - - IsLeaf := (Level = ColorBits); - if (IsLeaf) then - begin - Next := nil; - inc(LeafCount); - end else - begin - Next := ReducibleNodes[Level]; - ReducibleNodes[Level] := self; - end; -end; - -destructor TOctreeNode.Destroy; -var - i : integer; -begin - for i := High(Child) downto Low(Child) do - Child[i].Free; -end; - -constructor TColorQuantizer.Create(MaxColors: integer; ColorBits: integer); -var - i : integer; -begin - ASSERT(ColorBits <= 8, 'ColorBits must be 8 or less'); - - FTree := nil; - FLeafCount := 0; - - // Initialize all nodes even though only ColorBits+1 of them are needed - for i := Low(FReducibleNodes) to High(FReducibleNodes) do - FReducibleNodes[i] := nil; - - FMaxColors := MaxColors; - FColorBits := ColorBits; -end; - -destructor TColorQuantizer.Destroy; -begin - if (FTree <> nil) then - DeleteTree(FTree); -end; - -procedure TColorQuantizer.GetColorTable(var RGBQuadArray: TRGBQuadArray); -var - Index : integer; -begin - Index := 0; - GetPaletteColors(FTree, RGBQuadArray, Index); -end; - -// Handles passed to ProcessImage should refer to DIB sections, not DDBs. -// In certain cases, specifically when it's called upon to process 1, 4, or -// 8-bit per pixel images on systems with palettized display adapters, -// ProcessImage can produce incorrect results if it's passed a handle to a -// DDB. -function TColorQuantizer.ProcessImage(const DIB: TDIBReader): boolean; -var - i , - j : integer; - ScanLine : pointer; - Pixel : PRGBTriple; -begin - Result := True; - - for j := 0 to DIB.Bitmap.Height-1 do - begin - Scanline := DIB.Scanline[j]; - Pixel := ScanLine; - for i := 0 to DIB.Bitmap.Width-1 do - begin - with Pixel^ do - AddColor(FTree, rgbtRed, rgbtGreen, rgbtBlue, - FColorBits, 0, FLeafCount, FReducibleNodes); - - while FLeafCount > FMaxColors do - ReduceTree(FColorbits, FLeafCount, FReducibleNodes); - inc(Pixel); - end; - end; -end; - -procedure TColorQuantizer.AddColor(var Node: TOctreeNode; r,g,b: byte; - ColorBits: integer; Level: integer; var LeafCount: integer; - var ReducibleNodes: TReducibleNodes); -const - Mask: array[0..7] of BYTE = ($80, $40, $20, $10, $08, $04, $02, $01); -var - Index : integer; - Shift : integer; -begin - // If the node doesn't exist, create it. - if (Node = nil) then - Node := TOctreeNode.Create(Level, ColorBits, LeafCount, ReducibleNodes); - - if (Node.IsLeaf) then - begin - inc(Node.PixelCount); - inc(Node.RedSum, r); - inc(Node.GreenSum, g); - inc(Node.BlueSum, b); - end else - begin - // Recurse a level deeper if the node is not a leaf. - Shift := 7 - Level; - - Index := (((r and mask[Level]) SHR Shift) SHL 2) or - (((g and mask[Level]) SHR Shift) SHL 1) or - ((b and mask[Level]) SHR Shift); - AddColor(Node.Child[Index], r, g, b, ColorBits, Level+1, LeafCount, ReducibleNodes); - end; -end; - -procedure TColorQuantizer.DeleteTree(var Node: TOctreeNode); -var - i : integer; -begin - for i := High(TReducibleNodes) downto Low(TReducibleNodes) do - if (Node.Child[i] <> nil) then - DeleteTree(Node.Child[i]); - - Node.Free; - Node := nil; -end; - -procedure TColorQuantizer.GetPaletteColors(const Node: TOctreeNode; - var RGBQuadArray: TRGBQuadArray; var Index: integer); -var - i : integer; -begin - if (Node.IsLeaf) then - begin - with RGBQuadArray[Index] do - begin - if (Node.PixelCount <> 0) then - begin - rgbRed := BYTE(Node.RedSum DIV Node.PixelCount); - rgbGreen := BYTE(Node.GreenSum DIV Node.PixelCount); - rgbBlue := BYTE(Node.BlueSum DIV Node.PixelCount); - end else - begin - rgbRed := 0; - rgbGreen := 0; - rgbBlue := 0; - end; - rgbReserved := 0; - end; - inc(Index); - end else - begin - for i := Low(Node.Child) to High(Node.Child) do - if (Node.Child[i] <> nil) then - GetPaletteColors(Node.Child[i], RGBQuadArray, Index); - end; -end; - -procedure TColorQuantizer.ReduceTree(ColorBits: integer; var LeafCount: integer; - var ReducibleNodes: TReducibleNodes); -var - RedSum , - GreenSum , - BlueSum : integer; - Children : integer; - i : integer; - Node : TOctreeNode; -begin - // Find the deepest level containing at least one reducible node - i := Colorbits - 1; - while (i > 0) and (ReducibleNodes[i] = nil) do - dec(i); - - // Reduce the node most recently added to the list at level i. - Node := ReducibleNodes[i]; - ReducibleNodes[i] := Node.Next; - - RedSum := 0; - GreenSum := 0; - BlueSum := 0; - Children := 0; - - for i := Low(ReducibleNodes) to High(ReducibleNodes) do - if (Node.Child[i] <> nil) then - begin - inc(RedSum, Node.Child[i].RedSum); - inc(GreenSum, Node.Child[i].GreenSum); - inc(BlueSum, Node.Child[i].BlueSum); - inc(Node.PixelCount, Node.Child[i].PixelCount); - Node.Child[i].Free; - Node.Child[i] := nil; - inc(Children); - end; - - Node.IsLeaf := TRUE; - Node.RedSum := RedSum; - Node.GreenSum := GreenSum; - Node.BlueSum := BlueSum; - dec(LeafCount, Children-1); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// Octree Color Quantization Wrapper -// -//////////////////////////////////////////////////////////////////////////////// -// Adapted from Earl F. Glynn's PaletteLibrary, March 1998 -//////////////////////////////////////////////////////////////////////////////// - -// Wrapper for internal use - uses TDIBReader for bitmap access -function doCreateOptimizedPaletteFromSingleBitmap(const DIB: TDIBReader; - Colors, ColorBits: integer; Windows: boolean): hPalette; -var - SystemPalette : HPalette; - ColorQuantizer : TColorQuantizer; - i : integer; - LogicalPalette : TMaxLogPalette; - RGBQuadArray : TRGBQuadArray; - Offset : integer; -begin - LogicalPalette.palVersion := $0300; - LogicalPalette.palNumEntries := Colors; -// 2003.03.06 -> - {reset palette to black} - FillChar(LogicalPalette.palPalEntry, SizeOf(LogicalPalette.palPalEntry), 0); - for i := 0 to 255 do - LogicalPalette.palPalEntry[i].peFlags := PC_NOCOLLAPSE; -// 2003.03.06 <- - - if (Windows) then - begin - // Get the windows 20 color system palette - SystemPalette := GetStockObject(DEFAULT_PALETTE); - GetPaletteEntries(SystemPalette, 0, 10, LogicalPalette.palPalEntry[0]); - //GetPaletteEntries(SystemPalette, 10, 10, LogicalPalette.palPalEntry[245]); // wrong offset - GetPaletteEntries(SystemPalette, 10, 10, LogicalPalette.palPalEntry[246]); // 2003.03.06 - Colors := 236; - Offset := 10; - LogicalPalette.palNumEntries := 256; -{ Test code -// 2003.03.06 -> - // Get the windows 20 color system palette - SystemPalette := GetStockObject(DEFAULT_PALETTE); - GetPaletteEntries(SystemPalette, 0, 10, LogicalPalette.palPalEntry[0]); - GetPaletteEntries(SystemPalette, 10, 10, LogicalPalette.palPalEntry[10]); - Colors := 236; - Offset := 20; - LogicalPalette.palNumEntries := 256; -// 2003.03.06 <- -} - end else - Offset := 0; - - // Normally for 24-bit images, use ColorBits of 5 or 6. For 8-bit images - // use ColorBits = 8. - ColorQuantizer := TColorQuantizer.Create(Colors, ColorBits); - try - ColorQuantizer.ProcessImage(DIB); - ColorQuantizer.GetColorTable(RGBQuadArray); - finally - ColorQuantizer.Free; - end; - - for i := 0 to Colors-1 do - with LogicalPalette.palPalEntry[i+Offset] do - begin - peRed := RGBQuadArray[i].rgbRed; - peGreen := RGBQuadArray[i].rgbGreen; - peBlue := RGBQuadArray[i].rgbBlue; - peFlags := RGBQuadArray[i].rgbReserved; - end; - Result := CreatePalette(pLogPalette(@LogicalPalette)^); -end; - -function CreateOptimizedPaletteFromSingleBitmap(const Bitmap: TBitmap; - Colors, ColorBits: integer; Windows: boolean): hPalette; -var - DIB : TDIBReader; -begin - DIB := TDIBReader.Create(Bitmap, pf24bit); - try - Result := doCreateOptimizedPaletteFromSingleBitmap(DIB, Colors, ColorBits, Windows); - finally - DIB.Free; - end; -end; - -function CreateOptimizedPaletteFromManyBitmaps(Bitmaps: TList; Colors, ColorBits: integer; - Windows: boolean): hPalette; -var - SystemPalette : HPalette; - ColorQuantizer : TColorQuantizer; - i : integer; - LogicalPalette : TMaxLogPalette; - RGBQuadArray : TRGBQuadArray; - Offset : integer; - DIB : TDIBReader; -begin - if (Bitmaps = nil) or (Bitmaps.Count = 0) then - Error(sInvalidBitmapList); - - LogicalPalette.palVersion := $0300; - LogicalPalette.palNumEntries := Colors; -// 2003.03.06 -> - {reset palette to black} - FillChar(LogicalPalette.palPalEntry, SizeOf(LogicalPalette.palPalEntry), 0); - for i := 0 to 255 do - LogicalPalette.palPalEntry[i].peFlags := PC_NOCOLLAPSE; -// 2003.03.06 <- - - if (Windows) then - begin - // Get the windows 20 color system palette - SystemPalette := GetStockObject(DEFAULT_PALETTE); - GetPaletteEntries(SystemPalette, 0, 10, LogicalPalette.palPalEntry[0]); - //GetPaletteEntries(SystemPalette, 10, 10, LogicalPalette.palPalEntry[245]); // wrong offset - GetPaletteEntries(SystemPalette, 10, 10, LogicalPalette.palPalEntry[246]); // 2003.03.06 - Colors := 236; - Offset := 10; - LogicalPalette.palNumEntries := 256; -{ Test code -// 2003.03.06 -> - // Get the windows 20 color system palette - SystemPalette := GetStockObject(DEFAULT_PALETTE); - GetPaletteEntries(SystemPalette, 0, 10, LogicalPalette.palPalEntry[0]); - GetPaletteEntries(SystemPalette, 10, 10, LogicalPalette.palPalEntry[10]); - Colors := 236; - Offset := 20; - LogicalPalette.palNumEntries := 256; -// 2003.03.06 <- -} - end else - Offset := 0; - - // Normally for 24-bit images, use ColorBits of 5 or 6. For 8-bit images - // use ColorBits = 8. - ColorQuantizer := TColorQuantizer.Create(Colors, ColorBits); - try - for i := 0 to Bitmaps.Count-1 do - begin - DIB := TDIBReader.Create(TBitmap(Bitmaps[i]), pf24bit); - try - ColorQuantizer.ProcessImage(DIB); - finally - DIB.Free; - end; - end; - ColorQuantizer.GetColorTable(RGBQuadArray); - finally - ColorQuantizer.Free; - end; - - for i := 0 to Colors-1 do - with LogicalPalette.palPalEntry[i+Offset] do - begin - peRed := RGBQuadArray[i].rgbRed; - peGreen := RGBQuadArray[i].rgbGreen; - peBlue := RGBQuadArray[i].rgbBlue; - peFlags := RGBQuadArray[i].rgbReserved; - end; - Result := CreatePalette(pLogPalette(@LogicalPalette)^); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// Color reduction -// -//////////////////////////////////////////////////////////////////////////////// -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -//: Reduces the color depth of a bitmap using color quantization and dithering. -function ReduceColors(Bitmap: TBitmap; ColorReduction: TColorReduction; - DitherMode: TDitherMode; ReductionBits: integer; CustomPalette: hPalette): TBitmap; -var - Palette : hPalette; - ColorLookup : TColorLookup; - Ditherer : TDitherEngine; - Row : Integer; - DIBResult : TDIBWriter; - DIBSource : TDIBReader; - SrcScanLine , - Src : PRGBTriple; - DstScanLine , - Dst : PAnsiChar; - BGR : TRGBTriple; -{$ifdef DEBUG_DITHERPERFORMANCE} - TimeStart , - TimeStop : DWORD; -{$endif} - - function GrayScalePalette: hPalette; - var - i : integer; - Pal : TMaxLogPalette; - begin - Pal.palVersion := $0300; - Pal.palNumEntries := 256; - for i := 0 to 255 do - begin - // 2009.10.10 -> - //with (Pal.palPalEntry[i]) do - with Pal.palPalEntry[i] do - // 2009.10.10 <- - begin - peRed := i; - peGreen := i; - peBlue := i; - peFlags := PC_NOCOLLAPSE; - end; - end; - Result := CreatePalette(pLogPalette(@Pal)^); - end; - - function MonochromePalette: hPalette; - var - i : integer; - Pal : TMaxLogPalette; - const - Values : array[0..1] of byte - = (0, 255); - begin - Pal.palVersion := $0300; - Pal.palNumEntries := 2; - for i := 0 to 1 do - begin - // 2009.10.10 -> - //with (Pal.palPalEntry[i]) do - with Pal.palPalEntry[i] do - // 2009.10.10 <- - begin - peRed := Values[i]; - peGreen := Values[i]; - peBlue := Values[i]; - peFlags := PC_NOCOLLAPSE; - end; - end; - Result := CreatePalette(pLogPalette(@Pal)^); - end; - - function WindowsGrayScalePalette: hPalette; - var - i : integer; - Pal : TMaxLogPalette; - const - Values : array[0..3] of byte - = (0, 128, 192, 255); - begin - Pal.palVersion := $0300; - Pal.palNumEntries := 4; - for i := 0 to 3 do - begin - // 2009.10.10 -> - //with (Pal.palPalEntry[i]) do - with Pal.palPalEntry[i] do - // 2009.10.10 <- - begin - peRed := Values[i]; - peGreen := Values[i]; - peBlue := Values[i]; - peFlags := PC_NOCOLLAPSE; - end; - end; - Result := CreatePalette(pLogPalette(@Pal)^); - end; - - function WindowsHalftonePalette: hPalette; - var - DC : HDC; - begin - DC := GDICheck(GetDC(0)); - try - Result := CreateHalfTonePalette(DC); - finally - ReleaseDC(0, DC); - end; - end; - -begin -{$ifdef DEBUG_DITHERPERFORMANCE} - timeBeginPeriod(5); - TimeStart := timeGetTime; -{$endif} - - Result := TBitmap.Create; - try - - if (ColorReduction = rmNone) then - begin - Result.Assign(Bitmap); -{$ifndef VER9x} - SetPixelFormat(Result, pf24bit); -{$endif} - exit; - end; - -{$IFNDEF VER9x} - if (Bitmap.Width*Bitmap.Height > BitmapAllocationThreshold) then - SetPixelFormat(Result, pf1bit); // To reduce resource consumption of resize -{$ENDIF} - - ColorLookup := nil; - Ditherer := nil; - DIBResult := nil; - DIBSource := nil; - Palette := 0; - try // Protect above resources - - // Dithering and color mapper only supports 24 bit bitmaps, - // so we have convert the source bitmap to the appropiate format. - DIBSource := TDIBReader.Create(Bitmap, pf24bit); - - // Create a palette based on current options - case (ColorReduction) of - rmQuantize: - Palette := doCreateOptimizedPaletteFromSingleBitmap(DIBSource, 1 SHL ReductionBits, 8, False); - rmQuantizeWindows: - Palette := CreateOptimizedPaletteFromSingleBitmap(Bitmap, 256, 8, True); - rmNetscape: - Palette := WebPalette; - rmGrayScale: - Palette := GrayScalePalette; - rmMonochrome: - Palette := MonochromePalette; - rmWindowsGray: - Palette := WindowsGrayScalePalette; - rmWindows20: - Palette := GetStockObject(DEFAULT_PALETTE); - rmWindows256: - Palette := WindowsHalftonePalette; - rmPalette: - Palette := CopyPalette(CustomPalette); - else - exit; - end; - - {.TODO -oanme -cImprovement : Gray scale conversion should be done prior to dithering/mapping. Otherwise corrected values will be converted multiple times. } - - // Create a color mapper based on current options - case (ColorReduction) of - // For some strange reason my fast and dirty color lookup - // is more precise that Windows GetNearestPaletteIndex... - // rmWindows20: - // ColorLookup := TSlowColorLookup.Create(Palette); - // rmWindowsGray: - // ColorLookup := TGrayWindowsLookup.Create(Palette); - rmQuantize: -// 2007.01.18 -> // switch back to TFastColorLookup - ColorLookup := TFastColorLookup.Create(Palette); -// ColorLookup := TSlowColorLookup.Create(Palette); // 2003-03-06 -// 2007.01.18 <- - rmNetscape: - ColorLookup := TNetscapeColorLookup.Create(Palette); - rmGrayScale: - ColorLookup := TGrayScaleLookup.Create(Palette); - rmMonochrome: - ColorLookup := TMonochromeLookup.Create(Palette); - else -// ColorLookup := TFastColorLookup.Create(Palette); - ColorLookup := TSlowColorLookup.Create(Palette); // 2003-03-06 - end; - - // Nothing to do if palette doesn't contain any colors - if (ColorLookup.Colors = 0) then - exit; - - // Create a ditherer based on current options - case (DitherMode) of - dmNearest: - Ditherer := TDitherEngine.Create(Bitmap.Width, ColorLookup); - dmFloydSteinberg: - Ditherer := TFloydSteinbergDitherer.Create(Bitmap.Width, ColorLookup); - dmStucki: - Ditherer := TStuckiDitherer.Create(Bitmap.Width, ColorLookup); - dmSierra: - Ditherer := TSierraDitherer.Create(Bitmap.Width, ColorLookup); - dmJaJuNI: - Ditherer := TJaJuNIDitherer.Create(Bitmap.Width, ColorLookup); - dmSteveArche: - Ditherer := TSteveArcheDitherer.Create(Bitmap.Width, ColorLookup); - dmBurkes: - Ditherer := TBurkesDitherer.Create(Bitmap.Width, ColorLookup); - else - exit; - end; - - // The processed bitmap is returned in pf8bit format - DIBResult := TDIBWriter.Create(Result, pf8bit, Bitmap.Width, Bitmap.Height, - Palette); - - // Process the image - Row := 0; - while (Row < Bitmap.Height) do - begin - SrcScanline := DIBSource.ScanLine[Row]; - DstScanline := DIBResult.ScanLine[Row]; - Src := pointer(longInt(SrcScanLine) + Ditherer.Column*sizeof(TRGBTriple)); - Dst := pointer(longInt(DstScanLine) + Ditherer.Column); - - while (Ditherer.Column < Ditherer.Width) and (Ditherer.Column >= 0) do - begin - BGR := Src^; - // Dither and map a single pixel - Dst^ := Ditherer.Dither(BGR.rgbtRed, BGR.rgbtGreen, BGR.rgbtBlue, - BGR.rgbtRed, BGR.rgbtGreen, BGR.rgbtBlue); - - inc(Src, Ditherer.Direction); - inc(Dst, Ditherer.Direction); - end; - - Inc(Row); - Ditherer.NextLine; - end; - finally - if (ColorLookup <> nil) then - ColorLookup.Free; - if (Ditherer <> nil) then - Ditherer.Free; - if (DIBResult <> nil) then - DIBResult.Free; - if (DIBSource <> nil) then - DIBSource.Free; - // Must delete palette after TDIBWriter since TDIBWriter uses palette - if (Palette <> 0) then - DeleteObject(Palette); - end; - except - Result.Free; - raise; - end; - -{$ifdef DEBUG_DITHERPERFORMANCE} - TimeStop := timeGetTime; - ShowMessage(format('Dithered %d pixels in %d mS, Rate %d pixels/mS (%d pixels/S)', - [Bitmap.Height*Bitmap.Width, TimeStop-TimeStart, - MulDiv(Bitmap.Height, Bitmap.Width, TimeStop-TimeStart+1), - MulDiv(Bitmap.Height, Bitmap.Width * 1000, TimeStop-TimeStart+1)])); - timeEndPeriod(5); -{$endif} -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFColorMap -// -//////////////////////////////////////////////////////////////////////////////// -const - InitColorMapSize = 16; - DeltaColorMapSize = 32; - -//: Creates an instance of a TGIFColorMap object. -constructor TGIFColorMap.Create; -begin - inherited Create; - FColorMap := nil; - FCapacity := 0; - FCount := 0; - FOptimized := False; -end; - -//: Destroys an instance of a TGIFColorMap object. -destructor TGIFColorMap.Destroy; -begin - Clear; - Changed; - inherited Destroy; -end; - -//: Empties the color map. -procedure TGIFColorMap.Clear; -begin - if (FColorMap <> nil) then - FreeMem(FColorMap); - FColorMap := nil; - FCapacity := 0; - FCount := 0; - FOptimized := False; -end; - -//: Converts a Windows color value to a RGB value. -class function TGIFColorMap.Color2RGB(Color: TColor): TGIFColor; -begin - Result.Blue := (Color shr 16) and $FF; - Result.Green := (Color shr 8) and $FF; - Result.Red := Color and $FF; -end; - -//: Converts a RGB value to a Windows color value. -class function TGIFColorMap.RGB2Color(Color: TGIFColor): TColor; -begin - Result := (Color.Blue SHL 16) OR (Color.Green SHL 8) OR Color.Red; -end; - -//: Saves the color map to a stream. -procedure TGIFColorMap.SaveToStream(Stream: TStream); -var - Dummies : integer; - Dummy : TGIFColor; -begin - if (FCount = 0) then - exit; - Stream.WriteBuffer(FColorMap^, FCount*sizeof(TGIFColor)); - Dummies := (1 SHL BitsPerPixel)-FCount; - Dummy.Red := 0; - Dummy.Green := 0; - Dummy.Blue := 0; - while (Dummies > 0) do - begin - Stream.WriteBuffer(Dummy, sizeof(TGIFColor)); - dec(Dummies); - end; -end; - -//: Loads the color map from a stream. -procedure TGIFColorMap.LoadFromStream(Stream: TStream; Count: integer); -begin - Clear; - SetCapacity(Count); - ReadCheck(Stream, FColorMap^, Count*sizeof(TGIFColor)); - FCount := Count; -end; - -//: Returns the position of a color in the color map. -function TGIFColorMap.IndexOf(Color: TColor): integer; -var - RGB : TGIFColor; -begin - RGB := Color2RGB(Color); - if (FOptimized) then - begin - // Optimized palette has most frequently occuring entries first - Result := 0; - // Reverse search to (hopefully) check latest colors first - while (Result < FCount) do - with (FColorMap^[Result]) do - begin - if (RGB.Red = Red) and (RGB.Green = Green) and (RGB.Blue = Blue) then - exit; - Inc(Result); - end; - Result := -1; - end else - begin - Result := FCount-1; - // Reverse search to (hopefully) check latest colors first - while (Result >= 0) do - with (FColorMap^[Result]) do - begin - if (RGB.Red = Red) and (RGB.Green = Green) and (RGB.Blue = Blue) then - exit; - Dec(Result); - end; - end; -end; - -procedure TGIFColorMap.SetCapacity(Size: integer); -begin - if (Size >= FCapacity) then - begin - if (Size <= InitColorMapSize) then - FCapacity := InitColorMapSize - else - FCapacity := (Size + DeltaColorMapSize - 1) DIV DeltaColorMapSize * DeltaColorMapSize; - if (FCapacity > GIFMaxColors) then - FCapacity := GIFMaxColors; - ReallocMem(FColorMap, FCapacity * sizeof(TGIFColor)); - end; -end; - -//: Imports a Windows palette into the color map. -procedure TGIFColorMap.ImportPalette(Palette: HPalette); -type - PalArray = array[byte] of TPaletteEntry; -var - Pal : PalArray; - NewCount : integer; - i : integer; -begin - Clear; - NewCount := GetPaletteEntries(Palette, 0, 256, pal); - if (NewCount = 0) then - exit; - SetCapacity(NewCount); - for i := 0 to NewCount-1 do - with FColorMap[i], Pal[i] do - begin - Red := peRed; - Green := peGreen; - Blue := peBlue; - end; - FCount := NewCount; - Changed; -end; - -//: Imports a color map structure into the color map. -procedure TGIFColorMap.ImportColorMap(Map: TColorMap; Count: integer); -begin - Clear; - if (Count = 0) then - exit; - SetCapacity(Count); - FCount := Count; - - System.Move(Map, FColorMap^, FCount * sizeof(TGIFColor)); - - Changed; -end; - -//: Imports a Windows palette structure into the color map. -procedure TGIFColorMap.ImportColorTable(Pal: pointer; Count: integer); -var - i : integer; -begin - Clear; - if (Count = 0) then - exit; - SetCapacity(Count); - for i := 0 to Count-1 do - with FColorMap[i], PRGBQuadArray(Pal)[i] do - begin - Red := rgbRed; - Green := rgbGreen; - Blue := rgbBlue; - end; - FCount := Count; - Changed; -end; - -//: Imports the color table of a DIB into the color map. -procedure TGIFColorMap.ImportDIBColors(Handle: HDC); -var - Pal : Pointer; - NewCount : integer; -begin - Clear; - GetMem(Pal, sizeof(TRGBQuad) * 256); - try - NewCount := GetDIBColorTable(Handle, 0, 256, Pal^); - ImportColorTable(Pal, NewCount); - finally - FreeMem(Pal); - end; - Changed; -end; - -//: Creates a Windows palette from the color map. -function TGIFColorMap.ExportPalette: HPalette; -var - Pal : TMaxLogPalette; - i : Integer; -begin - if (Count = 0) then - begin - Result := 0; - exit; - end; - Pal.palVersion := $300; - Pal.palNumEntries := Count; - for i := 0 to Count-1 do - with FColorMap[i], Pal.palPalEntry[i] do - begin - peRed := Red; - peGreen := Green; - peBlue := Blue; - peFlags := PC_NOCOLLAPSE; {.TODO -oanme -cImprovement : Verify that PC_NOCOLLAPSE is the correct value to use. } - end; - Result := CreatePalette(PLogPalette(@Pal)^); -end; - -//: Adds a color to the color map. -function TGIFColorMap.Add(Color: TColor): integer; -begin - if (FCount >= GIFMaxColors) then - // Color map full - Error(sTooManyColors); - - Result := FCount; - if (Result >= FCapacity) then - SetCapacity(FCount+1); - FColorMap^[FCount] := Color2RGB(Color); - inc(FCount); - FOptimized := False; - Changed; -end; - -function TGIFColorMap.AddUnique(Color: TColor): integer; -begin - // Look up color before add (same as IndexOf) - Result := IndexOf(Color); - if (Result >= 0) then - // Color already in map - exit; - - Result := Add(Color); -end; - -//: Removes a color from the color map. -procedure TGIFColorMap.Delete(Index: integer); -begin - if (Index < 0) or (Index >= FCount) then - // Color index out of range - Error(sBadColorIndex); - dec(FCount); - if (Index < FCount) then - System.Move(FColorMap^[Index + 1], FColorMap^[Index], (FCount - Index)* sizeof(TGIFColor)); - FOptimized := False; - Changed; -end; - -function TGIFColorMap.GetColor(Index: integer): TColor; -begin - if (Index < 0) or (Index >= FCount) then - begin - // Color index out of range - Warning(gsWarning, sBadColorIndex); - // Raise an exception if the color map is empty - if (FCount = 0) then - Error(sEmptyColorMap); - // Default to color index 0 - Index := 0; - end; - Result := RGB2Color(FColorMap^[Index]); -end; - -procedure TGIFColorMap.SetColor(Index: integer; Value: TColor); -begin - if (Index < 0) or (Index >= FCount) then - // Color index out of range - Error(sBadColorIndex); - FColorMap^[Index] := Color2RGB(Value); - Changed; -end; - -function TGIFColorMap.DoOptimize: boolean; -var - Usage : TColormapHistogram; - TempMap : array[0..255] of TGIFColor; - ReverseMap : TColormapReverse; - i : integer; - LastFound : boolean; - NewCount : integer; - T : TUsageCount; - Pivot : integer; - - procedure QuickSort(iLo, iHi: Integer); - var - Lo, Hi: Integer; - begin - repeat - Lo := iLo; - Hi := iHi; - Pivot := Usage[(iLo + iHi) SHR 1].Count; - repeat - while (Usage[Lo].Count - Pivot > 0) do inc(Lo); - while (Usage[Hi].Count - Pivot < 0) do dec(Hi); - if (Lo <= Hi) then - begin - T := Usage[Lo]; - Usage[Lo] := Usage[Hi]; - Usage[Hi] := T; - inc(Lo); - dec(Hi); - end; - until (Lo > Hi); - if (iLo < Hi) then - QuickSort(iLo, Hi); - iLo := Lo; - until (Lo >= iHi); - end; - -begin - if (FCount <= 1) then - begin - Result := False; - exit; - end; - - FOptimized := True; - Result := True; - - BuildHistogram(Usage); - - (* - ** Sort according to usage count - *) - QuickSort(0, FCount-1); - - (* - ** Test for table already sorted - *) - for i := 0 to FCount-1 do - if (Usage[i].Index <> i) then - break; - if (i = FCount) then - exit; - - (* - ** Build old to new map - *) - for i := 0 to FCount-1 do - ReverseMap[Usage[i].Index] := i; - - - MapImages(ReverseMap); - - (* - ** Reorder colormap - *) - LastFound := False; - NewCount := FCount; - Move(FColorMap^, TempMap, FCount * sizeof(TGIFColor)); - for i := 0 to FCount-1 do - begin - FColorMap^[ReverseMap[i]] := TempMap[i]; - // Find last used color index - if (Usage[i].Count = 0) and not(LastFound) then - begin - LastFound := True; - NewCount := i; - end; - end; - - FCount := NewCount; - - Changed; -end; - -function TGIFColorMap.GetBitsPerPixel: integer; -begin - Result := Colors2bpp(FCount); -end; - -//: Copies one color map to another. -procedure TGIFColorMap.Assign(Source: TPersistent); -begin - if (Source is TGIFColorMap) then - begin - Clear; - FCapacity := TGIFColorMap(Source).FCapacity; - FCount := TGIFColorMap(Source).FCount; - FOptimized := TGIFColorMap(Source).FOptimized; - FColorMap := AllocMem(FCapacity * sizeof(TGIFColor)); - System.Move(TGIFColorMap(Source).FColorMap^, FColorMap^, FCount * sizeof(TGIFColor)); - Changed; - end else - inherited Assign(Source); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFItem -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFItem.Create(GIFImage: TGIFImage); -begin - inherited Create; - - FGIFImage := GIFImage; -end; - -procedure TGIFItem.Warning(Severity: TGIFSeverity; Message: string); -begin - FGIFImage.Warning(self, Severity, Message); -end; - -function TGIFItem.GetVersion: TGIFVersion; -begin - Result := gv87a; -end; - -procedure TGIFItem.LoadFromFile(const Filename: string); -var - Stream: TStream; -begin - Stream := TFileStream.Create(Filename, fmOpenRead OR fmShareDenyWrite); - try - LoadFromStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TGIFItem.SaveToFile(const Filename: string); -var - Stream: TStream; -begin - Stream := TFileStream.Create(Filename, fmCreate); - try - SaveToStream(Stream); - finally - Stream.Free; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFList -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFList.Create(Image: TGIFImage); -begin - inherited Create; - FImage := Image; - FItems := TList.Create; -end; - -destructor TGIFList.Destroy; -begin - Clear; - FItems.Free; - inherited Destroy; -end; - -function TGIFList.GetItem(Index: Integer): TGIFItem; -begin - Result := TGIFItem(FItems[Index]); -end; - -procedure TGIFList.SetItem(Index: Integer; Item: TGIFItem); -begin - FItems[Index] := Item; -end; - -function TGIFList.GetCount: Integer; -begin - Result := FItems.Count; -end; - -function TGIFList.Add(Item: TGIFItem): Integer; -begin - Result := FItems.Add(Item); -end; - -procedure TGIFList.Clear; -begin - while (FItems.Count > 0) do - Delete(0); -end; - -procedure TGIFList.Delete(Index: Integer); -var - Item : TGIFItem; -begin - Item := TGIFItem(FItems[Index]); - // Delete before item is destroyed to avoid recursion - FItems.Delete(Index); - Item.Free; -end; - -procedure TGIFList.Exchange(Index1, Index2: Integer); -begin - FItems.Exchange(Index1, Index2); -end; - -function TGIFList.First: TGIFItem; -begin - Result := TGIFItem(FItems.First); -end; - -function TGIFList.IndexOf(Item: TGIFItem): Integer; -begin - Result := FItems.IndexOf(Item); -end; - -procedure TGIFList.Insert(Index: Integer; Item: TGIFItem); -begin - FItems.Insert(Index, Item); -end; - -function TGIFList.Last: TGIFItem; -begin - Result := TGIFItem(FItems.Last); -end; - -procedure TGIFList.Move(CurIndex, NewIndex: Integer); -begin - FItems.Move(CurIndex, NewIndex); -end; - -function TGIFList.Remove(Item: TGIFItem): Integer; -begin - // Note: TGIFList.Remove must not destroy item - Result := FItems.Remove(Item); -end; - -procedure TGIFList.SaveToStream(Stream: TStream); -var - i : integer; -begin - for i := 0 to FItems.Count-1 do - TGIFItem(FItems[i]).SaveToStream(Stream); -end; - -procedure TGIFList.Warning(Severity: TGIFSeverity; Message: string); -begin - Image.Warning(self, Severity, Message); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFGlobalColorMap -// -//////////////////////////////////////////////////////////////////////////////// -type - TGIFGlobalColorMap = class(TGIFColorMap) - private - FHeader : TGIFHeader; - protected - procedure Warning(Severity: TGIFSeverity; Message: string); override; - procedure BuildHistogram(var Histogram: TColormapHistogram); override; - procedure MapImages(var Map: TColormapReverse); override; - public - constructor Create(HeaderItem: TGIFHeader); - function Optimize: boolean; override; - procedure Changed; override; - end; - -constructor TGIFGlobalColorMap.Create(HeaderItem: TGIFHeader); -begin - Inherited Create; - FHeader := HeaderItem; -end; - -procedure TGIFGlobalColorMap.Warning(Severity: TGIFSeverity; Message: string); -begin - FHeader.Image.Warning(self, Severity, Message); -end; - -procedure TGIFGlobalColorMap.BuildHistogram(var Histogram: TColormapHistogram); -var - Pixel , - LastPixel : PAnsiChar; - i : integer; -begin - (* - ** Init histogram - *) - for i := 0 to Count-1 do - begin - Histogram[i].Index := i; - Histogram[i].Count := 0; - end; - - for i := 0 to FHeader.Image.Images.Count-1 do - if (FHeader.Image.Images[i].ActiveColorMap = self) then - begin - Pixel := FHeader.Image.Images[i].Data; - LastPixel := Pixel + FHeader.Image.Images[i].Width * FHeader.Image.Images[i].Height; - - (* - ** Sum up usage count for each color - *) - while (Pixel < LastPixel) do - begin - inc(Histogram[ord(Pixel^)].Count); - inc(Pixel); - end; - end; -end; - -procedure TGIFGlobalColorMap.MapImages(var Map: TColormapReverse); -var - Pixel , - LastPixel : PAnsiChar; - i : integer; -begin - for i := 0 to FHeader.Image.Images.Count-1 do - if (FHeader.Image.Images[i].ActiveColorMap = self) then - begin - Pixel := FHeader.Image.Images[i].Data; - LastPixel := Pixel + FHeader.Image.Images[i].Width * FHeader.Image.Images[i].Height; - - (* - ** Reorder all pixel to new map - *) - while (Pixel < LastPixel) do - begin -// 2008.10.19 -> -// Pixel^ := chr(Map[ord(Pixel^)]); - Pixel^ := AnsiChar(Map[ord(Pixel^)]); -// 2008.10.19 <- - inc(Pixel); - end; - - (* - ** Reorder transparent colors - *) - if (FHeader.Image.Images[i].Transparent) then - FHeader.Image.Images[i].GraphicControlExtension.TransparentColorIndex := - Map[FHeader.Image.Images[i].GraphicControlExtension.TransparentColorIndex]; - end; -end; - -function TGIFGlobalColorMap.Optimize: boolean; -begin - { Optimize with first image, Remove unused colors if only one image } - if (FHeader.Image.Images.Count > 0) then - Result := DoOptimize - else - Result := False; -end; - -procedure TGIFGlobalColorMap.Changed; -begin - FHeader.Image.Palette := 0; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFHeader -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFHeader.Create(GIFImage: TGIFImage); -begin - inherited Create(GIFImage); - FColorMap := TGIFGlobalColorMap.Create(self); - Clear; -end; - -destructor TGIFHeader.Destroy; -begin - FColorMap.Free; - inherited Destroy; -end; - -procedure TGIFHeader.Clear; -begin - FColorMap.Clear; - FLogicalScreenDescriptor.ScreenWidth := 0; - FLogicalScreenDescriptor.ScreenHeight := 0; - FLogicalScreenDescriptor.PackedFields := 0; - FLogicalScreenDescriptor.BackgroundColorIndex := 0; - FLogicalScreenDescriptor.AspectRatio := 0; -end; - -procedure TGIFHeader.Assign(Source: TPersistent); -begin - if (Source is TGIFHeader) then - begin - ColorMap.Assign(TGIFHeader(Source).ColorMap); - FLogicalScreenDescriptor := TGIFHeader(Source).FLogicalScreenDescriptor; - end else - if (Source is TGIFColorMap) then - begin - Clear; - ColorMap.Assign(TGIFColorMap(Source)); - end else - inherited Assign(Source); -end; - -type - TGIFHeaderRec = packed record - Signature: array[0..2] of AnsiChar; { contains 'GIF' } - Version: TGIFVersionRec; { '87a' or '89a' } - end; - -const - { logical screen descriptor packed field masks } - lsdGlobalColorTable = $80; { set if global color table follows L.S.D. } - lsdColorResolution = $70; { Color resolution - 3 bits } - lsdSort = $08; { set if global color table is sorted - 1 bit } - lsdColorTableSize = $07; { size of global color table - 3 bits } - { Actual size = 2^value+1 - value is 3 bits } -procedure TGIFHeader.Prepare; -var - pack : BYTE; -begin - Pack := $00; - if (ColorMap.Count > 0) then - begin - Pack := lsdGlobalColorTable; - if (ColorMap.Optimized) then - Pack := Pack OR lsdSort; - end; - // Note: The SHL below was SHL 5 in the original source, but that looks wrong - Pack := Pack OR ((Image.ColorResolution SHL 4) AND lsdColorResolution); - Pack := Pack OR ((Image.BitsPerPixel-1) AND lsdColorTableSize); - FLogicalScreenDescriptor.PackedFields := Pack; -end; - -procedure TGIFHeader.SaveToStream(Stream: TStream); -var - GifHeader : TGIFHeaderRec; - v : TGIFVersion; -begin - v := Image.Version; - if (v = gvUnknown) then - Error(sBadVersion); - - GifHeader.Signature := 'GIF'; - GifHeader.Version := GIFVersions[v]; - - Prepare; - Stream.Write(GifHeader, sizeof(GifHeader)); - Stream.Write(FLogicalScreenDescriptor, sizeof(FLogicalScreenDescriptor)); - if (FLogicalScreenDescriptor.PackedFields AND lsdGlobalColorTable = lsdGlobalColorTable) then - ColorMap.SaveToStream(Stream); -end; - -procedure TGIFHeader.LoadFromStream(Stream: TStream); -var - GifHeader : TGIFHeaderRec; - ColorCount : integer; - Position : integer; -begin - Position := Stream.Position; - - ReadCheck(Stream, GifHeader, sizeof(GifHeader)); -// 2008.10.19 -> -// if (uppercase(GifHeader.Signature) <> 'GIF') then - if (uppercase(string(GifHeader.Signature)) <> 'GIF') then -// 2008.10.19 <- - begin - // Attempt recovery in case we are reading a GIF stored in a form by rxLib - Stream.Position := Position; - // Seek past size stored in stream - Stream.Seek(sizeof(longInt), soFromCurrent); - // Attempt to read signature again - ReadCheck(Stream, GifHeader, sizeof(GifHeader)); -// 2008.10.19 -> -// if (uppercase(GifHeader.Signature) <> 'GIF') then - if (uppercase(string(GifHeader.Signature)) <> 'GIF') then -// 2008.10.19 <- - Error(sBadSignature); - end; - - ReadCheck(Stream, FLogicalScreenDescriptor, sizeof(FLogicalScreenDescriptor)); - - if (FLogicalScreenDescriptor.PackedFields AND lsdGlobalColorTable = lsdGlobalColorTable) then - begin - ColorCount := 2 SHL (FLogicalScreenDescriptor.PackedFields AND lsdColorTableSize); - if (ColorCount < 2) or (ColorCount > 256) then - Error(sScreenBadColorSize); - ColorMap.LoadFromStream(Stream, ColorCount) - end else - ColorMap.Clear; -end; - -function TGIFHeader.GetVersion: TGIFVersion; -begin - if (FColorMap.Optimized) or (AspectRatio <> 0) then - Result := gv89a - else - Result := inherited GetVersion; -end; - -function TGIFHeader.GetBackgroundColor: TColor; -begin - Result := FColorMap[BackgroundColorIndex]; -end; - -procedure TGIFHeader.SetBackgroundColor(Color: TColor); -begin - BackgroundColorIndex := FColorMap.AddUnique(Color); -end; - -procedure TGIFHeader.SetBackgroundColorIndex(Index: BYTE); -begin - if ((Index >= FColorMap.Count) and (FColorMap.Count > 0)) then - begin - Warning(gsWarning, sBadColorIndex); - Index := 0; - end; - FLogicalScreenDescriptor.BackgroundColorIndex := Index; -end; - -function TGIFHeader.GetBitsPerPixel: integer; -begin - Result := FColorMap.BitsPerPixel; -end; - -function TGIFHeader.GetColorResolution: integer; -begin - Result := FColorMap.BitsPerPixel-1; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFLocalColorMap -// -//////////////////////////////////////////////////////////////////////////////// -type - TGIFLocalColorMap = class(TGIFColorMap) - private - FSubImage : TGIFSubImage; - protected - procedure Warning(Severity: TGIFSeverity; Message: string); override; - procedure BuildHistogram(var Histogram: TColormapHistogram); override; - procedure MapImages(var Map: TColormapReverse); override; - public - constructor Create(SubImage: TGIFSubImage); - function Optimize: boolean; override; - procedure Changed; override; - end; - -constructor TGIFLocalColorMap.Create(SubImage: TGIFSubImage); -begin - Inherited Create; - FSubImage := SubImage; -end; - -procedure TGIFLocalColorMap.Warning(Severity: TGIFSeverity; Message: string); -begin - FSubImage.Image.Warning(self, Severity, Message); -end; - -procedure TGIFLocalColorMap.BuildHistogram(var Histogram: TColormapHistogram); -var - Pixel , - LastPixel : PAnsiChar; - i : integer; -begin - Pixel := FSubImage.Data; - LastPixel := Pixel + FSubImage.Width * FSubImage.Height; - - (* - ** Init histogram - *) - for i := 0 to Count-1 do - begin - Histogram[i].Index := i; - Histogram[i].Count := 0; - end; - - (* - ** Sum up usage count for each color - *) - while (Pixel < LastPixel) do - begin - inc(Histogram[ord(Pixel^)].Count); - inc(Pixel); - end; -end; - -procedure TGIFLocalColorMap.MapImages(var Map: TColormapReverse); -var - Pixel , - LastPixel : PAnsiChar; -begin - Pixel := FSubImage.Data; - LastPixel := Pixel + FSubImage.Width * FSubImage.Height; - - (* - ** Reorder all pixel to new map - *) - while (Pixel < LastPixel) do - begin -// 2008.10.19 -> -// Pixel^ := chr(Map[ord(Pixel^)]); - Pixel^ := AnsiChar(Map[ord(Pixel^)]); -// 2008.10.19 <- - inc(Pixel); - end; - - (* - ** Reorder transparent colors - *) - if (FSubImage.Transparent) then - FSubImage.GraphicControlExtension.TransparentColorIndex := - Map[FSubImage.GraphicControlExtension.TransparentColorIndex]; -end; - -function TGIFLocalColorMap.Optimize: boolean; -begin - Result := DoOptimize; -end; - -procedure TGIFLocalColorMap.Changed; -begin - FSubImage.Palette := 0; -end; - - -//////////////////////////////////////////////////////////////////////////////// -// -// LZW Decoder -// -//////////////////////////////////////////////////////////////////////////////// -const - GIFCodeBits = 12; // Max number of bits per GIF token code - GIFCodeMax = (1 SHL GIFCodeBits)-1;// Max GIF token code - // 12 bits = 4095 - StackSize = (2 SHL GIFCodeBits); // Size of decompression stack - TableSize = (1 SHL GIFCodeBits); // Size of decompression table - -procedure TGIFSubImage.Decompress(Stream: TStream); -var - table0 : array[0..TableSize-1] of integer; - table1 : array[0..TableSize-1] of integer; - firstcode, oldcode : integer; - buf : array[0..257] of BYTE; - - Dest : PAnsiChar; - v , - xpos, ypos, pass : integer; - - stack : array[0..StackSize-1] of integer; - Source : ^integer; - BitsPerCode : integer; // number of CodeTableBits/code - InitialBitsPerCode : BYTE; - - MaxCode : integer; // maximum code, given BitsPerCode - MaxCodeSize : integer; - ClearCode : integer; // Special code to signal "Clear table" - EOFCode : integer; // Special code to signal EOF - step : integer; - i : integer; - - StartBit , // Index of bit buffer start - LastBit , // Index of last bit in buffer - LastByte : integer; // Index of last byte in buffer - get_done , - return_clear , - ZeroBlock : boolean; - ClearValue : BYTE; -{$ifdef DEBUG_DECOMPRESSPERFORMANCE} - TimeStartDecompress , - TimeStopDecompress : DWORD; -{$endif} - - function nextCode(BitsPerCode: integer): integer; - const - masks: array[0..15] of integer = - ($0000, $0001, $0003, $0007, - $000f, $001f, $003f, $007f, - $00ff, $01ff, $03ff, $07ff, - $0fff, $1fff, $3fff, $7fff); - var - StartIndex, EndIndex : integer; - ret : integer; - EndBit : integer; - count : BYTE; - begin - if (return_clear) then - begin - return_clear := False; - Result := ClearCode; - exit; - end; - - EndBit := StartBit + BitsPerCode; - - if (EndBit >= LastBit) then - begin - if (get_done) then - begin - if (StartBit >= LastBit) then - Warning(gsWarning, sDecodeTooFewBits); - Result := -1; - exit; - end; - buf[0] := buf[LastByte-2]; - buf[1] := buf[LastByte-1]; - - if (Stream.Read(count, 1) <> 1) then - begin - Result := -1; - exit; - end; - if (count = 0) then - begin - ZeroBlock := True; - get_done := TRUE; - end else - begin - // Handle premature end of file - if (Stream.Size - Stream.Position < Count) then - begin - Warning(gsWarning, sOutOfData); - // Not enough data left - Just read as much as we can get - Count := Stream.Size - Stream.Position; - end; - if (Count <> 0) then - ReadCheck(Stream, Buf[2], Count); - end; - - LastByte := 2 + count; - StartBit := (StartBit - LastBit) + 16; - LastBit := LastByte * 8; - - EndBit := StartBit + BitsPerCode; - end; - - EndIndex := EndBit DIV 8; - StartIndex := StartBit DIV 8; - - ASSERT(StartIndex <= high(buf), 'StartIndex too large'); - if (StartIndex = EndIndex) then - ret := buf[StartIndex] - else - if (StartIndex + 1 = EndIndex) then - ret := buf[StartIndex] OR (buf[StartIndex+1] SHL 8) - else - ret := buf[StartIndex] OR (buf[StartIndex+1] SHL 8) OR (buf[StartIndex+2] SHL 16); - - ret := (ret SHR (StartBit AND $0007)) AND masks[BitsPerCode]; - - Inc(StartBit, BitsPerCode); - - Result := ret; - end; - - function NextLZW: integer; - var - code, incode : integer; - i : integer; - b : BYTE; - begin - code := nextCode(BitsPerCode); - while (code >= 0) do - begin - if (code = ClearCode) then - begin - ASSERT(ClearCode < TableSize, 'ClearCode too large'); - for i := 0 to ClearCode-1 do - begin - table0[i] := 0; - table1[i] := i; - end; - for i := ClearCode to TableSize-1 do - begin - table0[i] := 0; - table1[i] := 0; - end; - BitsPerCode := InitialBitsPerCode+1; - MaxCodeSize := 2 * ClearCode; - MaxCode := ClearCode + 2; - Source := @stack; - repeat - firstcode := nextCode(BitsPerCode); - oldcode := firstcode; - until (firstcode <> ClearCode); - - Result := firstcode; - exit; - end; - if (code = EOFCode) then - begin - Result := -2; - if (ZeroBlock) then - exit; - // Eat rest of data blocks - if (Stream.Read(b, 1) <> 1) then - exit; - while (b <> 0) do - begin - Stream.Seek(b, soFromCurrent); - if (Stream.Read(b, 1) <> 1) then - exit; - end; - exit; - end; - - incode := code; - - if (code >= MaxCode) then - begin - Source^ := firstcode; - Inc(Source); - code := oldcode; - end; - - ASSERT(Code < TableSize, 'Code too large'); - while (code >= ClearCode) do - begin - Source^ := table1[code]; - Inc(Source); - if (code = table0[code]) then - Error(sDecodeCircular); - code := table0[code]; - ASSERT(Code < TableSize, 'Code too large'); - end; - - firstcode := table1[code]; - Source^ := firstcode; - Inc(Source); - - code := MaxCode; - if (code <= GIFCodeMax) then - begin - table0[code] := oldcode; - table1[code] := firstcode; - Inc(MaxCode); - if ((MaxCode >= MaxCodeSize) and (MaxCodeSize <= GIFCodeMax)) then - begin - MaxCodeSize := MaxCodeSize * 2; - Inc(BitsPerCode); - end; - end; - - oldcode := incode; - - if (longInt(Source) > longInt(@stack)) then - begin - Dec(Source); - Result := Source^; - exit; - end - end; - Result := code; - end; - - function readLZW: integer; - begin - if (longInt(Source) > longInt(@stack)) then - begin - Dec(Source); - Result := Source^; - end else - Result := NextLZW; - end; - -begin - NewImage; - - // Clear image data in case decompress doesn't complete - if (Transparent) then - // Clear to transparent color - ClearValue := GraphicControlExtension.GetTransparentColorIndex - else - // Clear to first color - ClearValue := 0; - - FillChar(FData^, FDataSize, ClearValue); - -{$ifdef DEBUG_DECOMPRESSPERFORMANCE} - TimeStartDecompress := timeGetTime; -{$endif} - - (* - ** Read initial code size in bits from stream - *) - if (Stream.Read(InitialBitsPerCode, 1) <> 1) then - exit; -// 2006.07.29 -> - if InitialBitsPerCode > 8 then - InitialBitsPerCode := 8; -// 2006.07.29 <- - (* - ** Initialize the Compression routines - *) - BitsPerCode := InitialBitsPerCode + 1; - ClearCode := 1 SHL InitialBitsPerCode; - EOFCode := ClearCode + 1; - MaxCodeSize := 2 * ClearCode; - MaxCode := ClearCode + 2; - - StartBit := 0; - LastBit := 0; - LastByte := 2; - - ZeroBlock := False; - get_done := False; - return_clear := TRUE; - - Source := @stack; - - try - if (Interlaced) then - begin - ypos := 0; - pass := 0; - step := 8; - - for i := 0 to Height-1 do - begin - Dest := FData + Width * ypos; - for xpos := 0 to width-1 do - begin - v := readLZW; - if (v < 0) then - exit; - Dest^ := AnsiChar(v); - Inc(Dest); - end; - Inc(ypos, step); - if (ypos >= height) then - repeat - if (pass > 0) then - step := step DIV 2; - Inc(pass); - ypos := step DIV 2; - until (ypos < height); - end; - end else - begin - Dest := FData; - for ypos := 0 to (height * width)-1 do - begin - v := readLZW; - if (v < 0) then - exit; - Dest^ := AnsiChar(v); - Inc(Dest); - end; - end; - finally - if (readLZW >= 0) then - ; -// raise GIFException.Create('Too much input data, ignoring extra...'); - end; -{$ifdef DEBUG_DECOMPRESSPERFORMANCE} - TimeStopDecompress := timeGetTime; - ShowMessage(format('Decompressed %d pixels in %d mS, Rate %d pixels/mS', - [Height*Width, TimeStopDecompress-TimeStartDecompress, - (Height*Width) DIV (TimeStopDecompress-TimeStartDecompress+1)])); -{$endif} -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// LZW Encoder stuff -// -//////////////////////////////////////////////////////////////////////////////// - -//////////////////////////////////////////////////////////////////////////////// -// LZW Encoder THashTable -//////////////////////////////////////////////////////////////////////////////// -const - HashKeyBits = 13; // Max number of bits per Hash Key - - HashSize = 8009; // Size of hash table - // Must be prime - // Must be > than HashMaxCode - // Must be < than HashMaxKey - - HashKeyMax = (1 SHL HashKeyBits)-1;// Max hash key value - // 13 bits = 8191 - - HashKeyMask = HashKeyMax; // $1FFF - GIFCodeMask = GIFCodeMax; // $0FFF - - HashEmpty = $000FFFFF; // 20 bits - -type - // A Hash Key is 20 bits wide. - // - The lower 8 bits are the postfix character (the new pixel). - // - The upper 12 bits are the prefix code (the GIF token). - // A KeyInt must be able to represent the integer values -1..(2^20)-1 - KeyInt = longInt; // 32 bits - CodeInt = SmallInt; // 16 bits - - THashArray = array[0..HashSize-1] of KeyInt; - PHashArray = ^THashArray; - - THashTable = class -{$ifdef DEBUG_HASHPERFORMANCE} - CountLookupFound : longInt; - CountMissFound : longInt; - CountLookupNotFound : longInt; - CountMissNotFound : longInt; -{$endif} - HashTable: PHashArray; - public - constructor Create; - destructor Destroy; override; - procedure Clear; - procedure Insert(Key: KeyInt; Code: CodeInt); - function Lookup(Key: KeyInt): CodeInt; - end; - -function HashKey(Key: KeyInt): CodeInt; -begin - Result := ((Key SHR (GIFCodeBits-8)) XOR Key) MOD HashSize; -end; - -function NextHashKey(HKey: CodeInt): CodeInt; -var - disp : CodeInt; -begin - (* - ** secondary hash (after G. Knott) - *) - disp := HashSize - HKey; - if (HKey = 0) then - disp := 1; -// disp := 13; // disp should be prime relative to HashSize, but - // it doesn't seem to matter here... - dec(HKey, disp); - if (HKey < 0) then - inc(HKey, HashSize); - Result := HKey; -end; - - -constructor THashTable.Create; -begin - ASSERT(longInt($FFFFFFFF) = -1, 'TGIFImage implementation assumes $FFFFFFFF = -1'); - - inherited Create; - GetMem(HashTable, sizeof(THashArray)); - Clear; -{$ifdef DEBUG_HASHPERFORMANCE} - CountLookupFound := 0; - CountMissFound := 0; - CountLookupNotFound := 0; - CountMissNotFound := 0; -{$endif} -end; - -destructor THashTable.Destroy; -begin -{$ifdef DEBUG_HASHPERFORMANCE} - ShowMessage( - Format('Found: %d HitRate: %.2f', - [CountLookupFound, (CountLookupFound+1)/(CountMissFound+1)])+#13+ - Format('Not found: %d HitRate: %.2f', - [CountLookupNotFound, (CountLookupNotFound+1)/(CountMissNotFound+1)])); -{$endif} - FreeMem(HashTable); - inherited Destroy; -end; - -// Clear hash table and fill with empty slots (doh!) -procedure THashTable.Clear; -{$ifdef DEBUG_HASHFILLFACTOR} -var - i , - Count : longInt; -{$endif} -begin -{$ifdef DEBUG_HASHFILLFACTOR} - Count := 0; - for i := 0 to HashSize-1 do - if (HashTable[i] SHR GIFCodeBits <> HashEmpty) then - inc(Count); - ShowMessage(format('Size: %d, Filled: %d, Rate %.4f', - [HashSize, Count, Count/HashSize])); -{$endif} - - FillChar(HashTable^, sizeof(THashArray), $FF); -end; - -// Insert new key/value pair into hash table -procedure THashTable.Insert(Key: KeyInt; Code: CodeInt); -var - HKey : CodeInt; -begin - // Create hash key from prefix string - HKey := HashKey(Key); - - // Scan for empty slot - // while (HashTable[HKey] SHR GIFCodeBits <> HashEmpty) do { Unoptimized } - while (HashTable[HKey] AND (HashEmpty SHL GIFCodeBits) <> (HashEmpty SHL GIFCodeBits)) do { Optimized } - HKey := NextHashKey(HKey); - // Fill slot with key/value pair - HashTable[HKey] := (Key SHL GIFCodeBits) OR (Code AND GIFCodeMask); -end; - -// Search for key in hash table. -// Returns value if found or -1 if not -function THashTable.Lookup(Key: KeyInt): CodeInt; -var - HKey : CodeInt; - HTKey : KeyInt; -{$ifdef DEBUG_HASHPERFORMANCE} - n : LongInt; -{$endif} -begin - // Create hash key from prefix string - HKey := HashKey(Key); - -{$ifdef DEBUG_HASHPERFORMANCE} - n := 0; -{$endif} - // Scan table for key - // HTKey := HashTable[HKey] SHR GIFCodeBits; { Unoptimized } - Key := Key SHL GIFCodeBits; { Optimized } - HTKey := HashTable[HKey] AND (HashEmpty SHL GIFCodeBits); { Optimized } - // while (HTKey <> HashEmpty) do { Unoptimized } - while (HTKey <> HashEmpty SHL GIFCodeBits) do { Optimized } - begin - if (Key = HTKey) then - begin - // Extract and return value - Result := HashTable[HKey] AND GIFCodeMask; -{$ifdef DEBUG_HASHPERFORMANCE} - inc(CountLookupFound); - inc(CountMissFound, n); -{$endif} - exit; - end; -{$ifdef DEBUG_HASHPERFORMANCE} - inc(n); -{$endif} - // Try next slot - HKey := NextHashKey(HKey); - // HTKey := HashTable[HKey] SHR GIFCodeBits; { Unoptimized } - HTKey := HashTable[HKey] AND (HashEmpty SHL GIFCodeBits); { Optimized } - end; - // Found empty slot - key doesn't exist - Result := -1; -{$ifdef DEBUG_HASHPERFORMANCE} - inc(CountLookupNotFound); - inc(CountMissNotFound, n); -{$endif} -end; - -//////////////////////////////////////////////////////////////////////////////// -// TGIFStream - Abstract GIF block stream -// -// Descendants from TGIFStream either reads or writes data in blocks -// of up to 255 bytes. These blocks are organized as a leading byte -// containing the number of bytes in the block (exclusing the count -// byte itself), followed by the data (up to 254 bytes of data). -//////////////////////////////////////////////////////////////////////////////// -type - TGIFStream = class(TStream) - private - FOnWarning : TGIFWarning; - FStream : TStream; - FOnProgress : TNotifyEvent; - FBuffer : array [BYTE] of AnsiChar; - FBufferCount : integer; - - protected - constructor Create(Stream: TStream); - - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(Offset: Longint; Origin: Word): Longint; override; - - procedure Progress(Sender: TObject); dynamic; - property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; - public - property Warning: TGIFWarning read FOnWarning write FOnWarning; - end; - -constructor TGIFStream.Create(Stream: TStream); -begin - inherited Create; - FStream := Stream; - FBufferCount := 1; // Reserve first byte of buffer for length -end; - -procedure TGIFStream.Progress(Sender: TObject); -begin - if Assigned(FOnProgress) then - FOnProgress(Sender); -end; - -function TGIFStream.Write(const Buffer; Count: Longint): Longint; -begin - raise Exception.Create(sInvalidStream); -end; - -function TGIFStream.Read(var Buffer; Count: Longint): Longint; -begin - raise Exception.Create(sInvalidStream); -end; - -function TGIFStream.Seek(Offset: Longint; Origin: Word): Longint; -begin - raise Exception.Create(sInvalidStream); -end; - -//////////////////////////////////////////////////////////////////////////////// -// TGIFReader - GIF block reader -//////////////////////////////////////////////////////////////////////////////// -type - TGIFReader = class(TGIFStream) - public - constructor Create(Stream: TStream); - - function Read(var Buffer; Count: Longint): Longint; override; - end; - -constructor TGIFReader.Create(Stream: TStream); -begin - inherited Create(Stream); - FBufferCount := 0; -end; - -function TGIFReader.Read(var Buffer; Count: Longint): Longint; -var - n : integer; - Dst : PAnsiChar; - size : BYTE; -begin - Dst := @Buffer; - Result := 0; - - while (Count > 0) do - begin - // Get data from buffer - while (FBufferCount > 0) and (Count > 0) do - begin - if (FBufferCount > Count) then - n := Count - else - n := FBufferCount; - Move(FBuffer, Dst^, n); - dec(FBufferCount, n); - dec(Count, n); - inc(Result, n); - inc(Dst, n); - end; - - // Refill buffer when it becomes empty - if (FBufferCount <= 0) then - begin - FStream.Read(size, 1); - {.TODO -oanme -cImprovement : Should be handled as a warning instead of an error. } - if (size >= 255) then - Error('GIF block too large'); - FBufferCount := size; - if (FBufferCount > 0) then - begin - n := FStream.Read(FBuffer, size); - if (n = FBufferCount) then - begin - Warning(self, gsWarning, sOutOfData); - break; - end; - end else - break; - end; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -// TGIFWriter - GIF block writer -//////////////////////////////////////////////////////////////////////////////// -type - TGIFWriter = class(TGIFStream) - private - FOutputDirty : boolean; - - protected - procedure FlushBuffer; - - public - constructor Create(Stream: TStream); - destructor Destroy; override; - - function Write(const Buffer; Count: Longint): Longint; override; - function WriteByte(Value: BYTE): Longint; - end; - -constructor TGIFWriter.Create(Stream: TStream); -begin - inherited Create(Stream); - FBufferCount := 1; // Reserve first byte of buffer for length - FOutputDirty := False; -end; - -destructor TGIFWriter.Destroy; -begin - inherited Destroy; - if (FOutputDirty) then - FlushBuffer; -end; - -procedure TGIFWriter.FlushBuffer; -begin - if (FBufferCount <= 0) then - exit; - - FBuffer[0] := AnsiChar(FBufferCount-1); // Block size excluding the count - FStream.WriteBuffer(FBuffer, FBufferCount); - FBufferCount := 1; // Reserve first byte of buffer for length - FOutputDirty := False; -end; - -function TGIFWriter.Write(const Buffer; Count: Longint): Longint; -var - n : integer; - Src : PAnsiChar; -begin - Result := Count; - FOutputDirty := True; - Src := @Buffer; - while (Count > 0) do - begin - // Move data to the internal buffer in 255 byte chunks - while (FBufferCount < sizeof(FBuffer)) and (Count > 0) do - begin - n := sizeof(FBuffer) - FBufferCount; - if (n > Count) then - n := Count; - Move(Src^, FBuffer[FBufferCount], n); - inc(Src, n); - inc(FBufferCount, n); - dec(Count, n); - end; - - // Flush the buffer when it is full - if (FBufferCount >= sizeof(FBuffer)) then - FlushBuffer; - end; -end; - -function TGIFWriter.WriteByte(Value: BYTE): Longint; -begin - Result := Write(Value, 1); -end; - -//////////////////////////////////////////////////////////////////////////////// -// TGIFEncoder - Abstract encoder -//////////////////////////////////////////////////////////////////////////////// -type - TGIFEncoder = class(TObject) - protected - FOnWarning : TGIFWarning; - MaxColor : integer; - BitsPerPixel : BYTE; // Bits per pixel of image - Stream : TStream; // Output stream - Width , // Width of image in pixels - Height : integer; // height of image in pixels - Interlace : boolean; // Interlace flag (True = interlaced image) - Data : PAnsiChar; // Pointer to pixel data - GIFStream : TGIFWriter; // Output buffer - - OutputBucket : longInt; // Output bit bucket - OutputBits : integer; // Current # of bits in bucket - - ClearFlag : Boolean; // True if dictionary has just been cleared - BitsPerCode , // Current # of bits per code - InitialBitsPerCode : integer; // Initial # of bits per code after - // dictionary has been cleared - MaxCode : CodeInt; // maximum code, given BitsPerCode - ClearCode : CodeInt; // Special output code to signal "Clear table" - EOFCode : CodeInt; // Special output code to signal EOF - BaseCode : CodeInt; // ... - - Pixel : PAnsiChar; // Pointer to current pixel - - cX , // Current X counter (Width - X) - Y : integer; // Current Y - Pass : integer; // Interlace pass - - function MaxCodesFromBits(Bits: integer): CodeInt; - procedure Output(Value: integer); virtual; - procedure Clear; virtual; - function BumpPixel: boolean; - procedure DoCompress; virtual; abstract; - public - procedure Compress(AStream: TStream; ABitsPerPixel: integer; - AWidth, AHeight: integer; AInterlace: boolean; AData: PAnsiChar; AMaxColor: integer); - property Warning: TGIFWarning read FOnWarning write FOnWarning; - end; - -// Calculate the maximum number of codes that a given number of bits can represent -// MaxCodes := (1^bits)-1 -function TGIFEncoder.MaxCodesFromBits(Bits: integer): CodeInt; -begin - Result := (CodeInt(1) SHL Bits) - 1; -end; - -// Stuff bits (variable sized codes) into a buffer and output them -// a byte at a time -procedure TGIFEncoder.Output(Value: integer); -const - BitBucketMask: array[0..16] of longInt = - ($0000, - $0001, $0003, $0007, $000F, - $001F, $003F, $007F, $00FF, - $01FF, $03FF, $07FF, $0FFF, - $1FFF, $3FFF, $7FFF, $FFFF); -begin - if (OutputBits > 0) then - OutputBucket := - (OutputBucket AND BitBucketMask[OutputBits]) OR (longInt(Value) SHL OutputBits) - else - OutputBucket := Value; - - inc(OutputBits, BitsPerCode); - - while (OutputBits >= 8) do - begin - GIFStream.WriteByte(OutputBucket AND $FF); - OutputBucket := OutputBucket SHR 8; - dec(OutputBits, 8); - end; - - if (Value = EOFCode) then - begin - // At EOF, write the rest of the buffer. - while (OutputBits > 0) do - begin - GIFStream.WriteByte(OutputBucket AND $FF); - OutputBucket := OutputBucket SHR 8; - dec(OutputBits, 8); - end; - end; -end; - -procedure TGIFEncoder.Clear; -begin - // just_cleared = 1; - ClearFlag := TRUE; - Output(ClearCode); -end; - -// Bump (X,Y) and data pointer to point to the next pixel -function TGIFEncoder.BumpPixel: boolean; -begin - // Bump the current X position - dec(cX); - - // If we are at the end of a scan line, set cX back to the beginning - // If we are interlaced, bump Y to the appropriate spot, otherwise, - // just increment it. - if (cX <= 0) then - begin - - if not(Interlace) then - begin - // Done - no more data - Result := False; - exit; - end; - - cX := Width; - case (Pass) of - 0: - begin - inc(Y, 8); - if (Y >= Height) then - begin - inc(Pass); - Y := 4; - end; - end; - 1: - begin - inc(Y, 8); - if (Y >= Height) then - begin - inc(Pass); - Y := 2; - end; - end; - 2: - begin - inc(Y, 4); - if (Y >= Height) then - begin - inc(Pass); - Y := 1; - end; - end; - 3: - inc(Y, 2); - end; - - if (Y >= height) then - begin - // Done - No more data - Result := False; - exit; - end; - Pixel := Data + (Y * Width); - end; - Result := True; -end; - - -procedure TGIFEncoder.Compress(AStream: TStream; ABitsPerPixel: integer; - AWidth, AHeight: integer; AInterlace: boolean; AData: PAnsiChar; AMaxColor: integer); -const - EndBlockByte = $00; // End of block marker -{$ifdef DEBUG_COMPRESSPERFORMANCE} -var - TimeStartCompress , - TimeStopCompress : DWORD; -{$endif} -begin - MaxColor := AMaxColor; - Stream := AStream; - BitsPerPixel := ABitsPerPixel; - Width := AWidth; - Height := AHeight; - Interlace := AInterlace; - Data := AData; - - if (BitsPerPixel <= 1) then - BitsPerPixel := 2; - - InitialBitsPerCode := BitsPerPixel + 1; - Stream.Write(BitsPerPixel, 1); - - // out_bits_init = init_bits; - BitsPerCode := InitialBitsPerCode; - MaxCode := MaxCodesFromBits(BitsPerCode); - - ClearCode := (1 SHL (InitialBitsPerCode - 1)); - EOFCode := ClearCode + 1; - BaseCode := EOFCode + 1; - - // Clear bit bucket - OutputBucket := 0; - OutputBits := 0; - - // Reset pixel counter - if (Interlace) then - cX := Width - else - cX := Width*Height; - // Reset row counter - Y := 0; - Pass := 0; - - GIFStream := TGIFWriter.Create(AStream); - try - GIFStream.Warning := Warning; - if (Data <> nil) and (Height > 0) and (Width > 0) then - begin -{$ifdef DEBUG_COMPRESSPERFORMANCE} - TimeStartCompress := timeGetTime; -{$endif} - - // Call compress implementation - DoCompress; - -{$ifdef DEBUG_COMPRESSPERFORMANCE} - TimeStopCompress := timeGetTime; - ShowMessage(format('Compressed %d pixels in %d mS, Rate %d pixels/mS', - [Height*Width, TimeStopCompress-TimeStartCompress, - DWORD(Height*Width) DIV (TimeStopCompress-TimeStartCompress+1)])); -{$endif} - // Output the final code. - Output(EOFCode); - end else - // Output the final code (and nothing else). - TGIFEncoder(self).Output(EOFCode); - finally - GIFStream.Free; - end; - - WriteByte(Stream, EndBlockByte); -end; - -//////////////////////////////////////////////////////////////////////////////// -// TRLEEncoder - RLE encoder -//////////////////////////////////////////////////////////////////////////////// -type - TRLEEncoder = class(TGIFEncoder) - private - MaxCodes : integer; - OutBumpInit , - OutClearInit : integer; - Prefix : integer; // Current run color - RunLengthTableMax , - RunLengthTablePixel , - OutCount , - OutClear , - OutBump : integer; - protected - function ComputeTriangleCount(count: integer; nrepcodes: integer): integer; - procedure MaxOutClear; - procedure ResetOutClear; - procedure FlushFromClear(Count: integer); - procedure FlushClearOrRepeat(Count: integer); - procedure FlushWithTable(Count: integer); - procedure Flush(RunLengthCount: integer); - procedure OutputPlain(Value: integer); - procedure Clear; override; - procedure DoCompress; override; - end; - - -procedure TRLEEncoder.Clear; -begin - OutBump := OutBumpInit; - OutClear := OutClearInit; - OutCount := 0; - RunLengthTableMax := 0; - - inherited Clear; - - BitsPerCode := InitialBitsPerCode; -end; - -procedure TRLEEncoder.OutputPlain(Value: integer); -begin - ClearFlag := False; - Output(Value); - inc(OutCount); - - if (OutCount >= OutBump) then - begin - inc(BitsPerCode); - inc(OutBump, 1 SHL (BitsPerCode - 1)); - end; - - if (OutCount >= OutClear) then - Clear; -end; - -function TRLEEncoder.ComputeTriangleCount(count: integer; nrepcodes: integer): integer; -var - PerRepeat : integer; - n : integer; - - function iSqrt(x: integer): integer; - var - r, v : integer; - begin - if (x < 2) then - begin - Result := x; - exit; - end else - begin - v := x; - r := 1; - while (v > 0) do - begin - v := v DIV 4; - r := r * 2; - end; - end; - - while (True) do - begin - v := ((x DIV r) + r) DIV 2; - if ((v = r) or (v = r+1)) then - begin - Result := r; - exit; - end; - r := v; - end; - end; - -begin - Result := 0; - PerRepeat := (nrepcodes * (nrepcodes+1)) DIV 2; - - while (Count >= PerRepeat) do - begin - inc(Result, nrepcodes); - dec(Count, PerRepeat); - end; - - if (Count > 0) then - begin - n := iSqrt(Count); - while ((n * (n+1)) >= 2*Count) do - dec(n); - while ((n * (n+1)) < 2*Count) do - inc(n); - inc(Result, n); - end; -end; - -procedure TRLEEncoder.MaxOutClear; -begin - OutClear := MaxCodes; -end; - -procedure TRLEEncoder.ResetOutClear; -begin - OutClear := OutClearInit; - if (OutCount >= OutClear) then - Clear; -end; - -procedure TRLEEncoder.FlushFromClear(Count: integer); -var - n : integer; -begin - MaxOutClear; - RunLengthTablePixel := Prefix; - n := 1; - while (Count > 0) do - begin - if (n = 1) then - begin - RunLengthTableMax := 1; - OutputPlain(Prefix); - dec(Count); - end else - if (Count >= n) then - begin - RunLengthTableMax := n; - OutputPlain(BaseCode + n - 2); - dec(Count, n); - end else - if (Count = 1) then - begin - inc(RunLengthTableMax); - OutputPlain(Prefix); - break; - end else - begin - inc(RunLengthTableMax); - OutputPlain(BaseCode + Count - 2); - break; - end; - - if (OutCount = 0) then - n := 1 - else - inc(n); - end; - ResetOutClear; -end; - -procedure TRLEEncoder.FlushClearOrRepeat(Count: integer); -var - WithClear : integer; -begin - WithClear := 1 + ComputeTriangleCount(Count, MaxCodes); - - if (WithClear < Count) then - begin - Clear; - FlushFromClear(Count); - end else - while (Count > 0) do - begin - OutputPlain(Prefix); - dec(Count); - end; -end; - -procedure TRLEEncoder.FlushWithTable(Count: integer); -var - RepeatMax , - RepeatLeft , - LeftOver : integer; -begin - RepeatMax := Count DIV RunLengthTableMax; - LeftOver := Count MOD RunLengthTableMax; - if (LeftOver <> 0) then - RepeatLeft := 1 - else - RepeatLeft := 0; - - if (OutCount + RepeatMax + RepeatLeft > MaxCodes) then - begin - RepeatMax := MaxCodes - OutCount; - LeftOver := Count - (RepeatMax * RunLengthTableMax); - RepeatLeft := 1 + ComputeTriangleCount(LeftOver, MaxCodes); - end; - - if (1 + ComputeTriangleCount(Count, MaxCodes) < RepeatMax + RepeatLeft) then - begin - Clear; - FlushFromClear(Count); - exit; - end; - MaxOutClear; - - while (RepeatMax > 0) do - begin - OutputPlain(BaseCode + RunLengthTableMax-2); - dec(RepeatMax); - end; - - if (LeftOver > 0) then - begin - if (ClearFlag) then - FlushFromClear(LeftOver) - else if (LeftOver = 1) then - OutputPlain(Prefix) - else - OutputPlain(BaseCode + LeftOver - 2); - end; - ResetOutClear; -end; - -procedure TRLEEncoder.Flush(RunLengthCount: integer); -begin - if (RunLengthCount = 1) then - begin - OutputPlain(Prefix); - exit; - end; - - if (ClearFlag) then - FlushFromClear(RunLengthCount) - else if ((RunLengthTableMax < 2) or (RunLengthTablePixel <> Prefix)) then - FlushClearOrRepeat(RunLengthCount) - else - FlushWithTable(RunLengthCount); -end; - -procedure TRLEEncoder.DoCompress; -var - Color : CodeInt; - RunLengthCount : integer; - -begin - OutBumpInit := ClearCode - 1; - - // For images with a lot of runs, making OutClearInit larger will - // give better compression. - if (BitsPerPixel <= 3) then - OutClearInit := 9 - else - OutClearInit := OutBumpInit - 1; - - // max_ocodes = (1 << GIFBITS) - ((1 << (out_bits_init - 1)) + 3); - // <=> MaxCodes := (1 SHL GIFCodeBits) - ((1 SHL (BitsPerCode - 1)) + 3); - // <=> MaxCodes := (1 SHL GIFCodeBits) - ((1 SHL (InitialBitsPerCode - 1)) + 3); - // <=> MaxCodes := (1 SHL GIFCodeBits) - (ClearCode + 3); - // <=> MaxCodes := (1 SHL GIFCodeBits) - (EOFCode + 2); - // <=> MaxCodes := (1 SHL GIFCodeBits) - (BaseCode + 1); - // <=> MaxCodes := MaxCodesFromBits(GIFCodeBits) - BaseCode; - MaxCodes := MaxCodesFromBits(GIFCodeBits) - BaseCode; - - Clear; - RunLengthCount := 0; - - Pixel := Data; - Prefix := -1; // Dummy value to make Color <> Prefix - repeat - // Fetch the next pixel - Color := CodeInt(Pixel^); - inc(Pixel); - - if (Color >= MaxColor) then - Error(sInvalidColor); - - if (RunLengthCount > 0) and (Color <> Prefix) then - begin - // End of current run - Flush(RunLengthCount); - RunLengthCount := 0; - end; - - if (Color = Prefix) then - // Increment run length - inc(RunLengthCount) - else - begin - // Start new run - Prefix := Color; - RunLengthCount := 1; - end; - until not(BumpPixel); - Flush(RunLengthCount); -end; - -//////////////////////////////////////////////////////////////////////////////// -// TLZWEncoder - LZW encoder -//////////////////////////////////////////////////////////////////////////////// -const - TableMaxMaxCode = (1 SHL GIFCodeBits); // - TableMaxFill = TableMaxMaxCode-1; // Clear table when it fills to - // this point. - // Note: Must be <= GIFCodeMax -type - TLZWEncoder = class(TGIFEncoder) - private - Prefix : CodeInt; // Current run color - FreeEntry : CodeInt; // next unused code in table - HashTable : THashTable; - protected - procedure Output(Value: integer); override; - procedure Clear; override; - procedure DoCompress; override; - end; - - -procedure TLZWEncoder.Output(Value: integer); -begin - inherited Output(Value); - - // If the next entry is going to be too big for the code size, - // then increase it, if possible. - if (FreeEntry > MaxCode) or (ClearFlag) then - begin - if (ClearFlag) then - begin - BitsPerCode := InitialBitsPerCode; - MaxCode := MaxCodesFromBits(BitsPerCode); - ClearFlag := False; - end else - begin - inc(BitsPerCode); - if (BitsPerCode = GIFCodeBits) then - MaxCode := TableMaxMaxCode - else - MaxCode := MaxCodesFromBits(BitsPerCode); - end; - end; -end; - -procedure TLZWEncoder.Clear; -begin - inherited Clear; - HashTable.Clear; - FreeEntry := ClearCode + 2; -end; - - -procedure TLZWEncoder.DoCompress; -var - Color : AnsiChar; - NewKey : KeyInt; - NewCode : CodeInt; - -begin - HashTable := THashTable.Create; - try - // clear hash table and sync decoder - Clear; - - Pixel := Data; - Prefix := CodeInt(Pixel^); - inc(Pixel); - if (Prefix >= MaxColor) then - Error(sInvalidColor); - while (BumpPixel) do - begin - // Fetch the next pixel - Color := Pixel^; - inc(Pixel); - if (ord(Color) >= MaxColor) then - Error(sInvalidColor); - - // Append Postfix to Prefix and lookup in table... - NewKey := (KeyInt(Prefix) SHL 8) OR ord(Color); - NewCode := HashTable.Lookup(NewKey); - if (NewCode >= 0) then - begin - // ...if found, get next pixel - Prefix := NewCode; - continue; - end; - - // ...if not found, output and start over - Output(Prefix); - Prefix := CodeInt(Color); - - if (FreeEntry < TableMaxFill) then - begin - HashTable.Insert(NewKey, FreeEntry); - inc(FreeEntry); - end else - Clear; - end; - Output(Prefix); - finally - HashTable.Free; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFSubImage -// -//////////////////////////////////////////////////////////////////////////////// - -///////////////////////////////////////////////////////////////////////// -// TGIFSubImage.Compress -///////////////////////////////////////////////////////////////////////// -procedure TGIFSubImage.Compress(Stream: TStream); -var - Encoder : TGIFEncoder; - BitsPerPixel : BYTE; - MaxColors : integer; -begin - if (ColorMap.Count > 0) then - begin - MaxColors := ColorMap.Count; - BitsPerPixel := ColorMap.BitsPerPixel - end else - begin - BitsPerPixel := Image.BitsPerPixel; - MaxColors := 1 SHL BitsPerPixel; - end; - - // Create a RLE or LZW GIF encoder - if (Image.Compression = gcRLE) then - Encoder := TRLEEncoder.Create - else - Encoder := TLZWEncoder.Create; - try - Encoder.Warning := Image.Warning; - Encoder.Compress(Stream, BitsPerPixel, Width, Height, Interlaced, FData, MaxColors); - finally - Encoder.Free; - end; -end; - -function TGIFExtensionList.GetExtension(Index: Integer): TGIFExtension; -begin - Result := TGIFExtension(Items[Index]); -end; - -procedure TGIFExtensionList.SetExtension(Index: Integer; Extension: TGIFExtension); -begin - Items[Index] := Extension; -end; - -procedure TGIFExtensionList.LoadFromStream(Stream: TStream; Parent: TObject); -var - b : BYTE; - Extension : TGIFExtension; - ExtensionClass : TGIFExtensionClass; -begin - // Peek ahead to determine block type - if (Stream.Read(b, 1) <> 1) then - exit; - while not(b in [bsTrailer, bsImageDescriptor]) do - begin - if (b = bsExtensionIntroducer) then - begin - ExtensionClass := TGIFExtension.FindExtension(Stream); - if (ExtensionClass = nil) then - Error(sUnknownExtension); - Stream.Seek(-1, soFromCurrent); - Extension := ExtensionClass.Create(Parent as TGIFSubImage); - try - Extension.LoadFromStream(Stream); - Add(Extension); - except - Extension.Free; - raise; - end; - end else - begin - Warning(gsWarning, sBadExtensionLabel); - break; - end; - if (Stream.Read(b, 1) <> 1) then - exit; - end; - Stream.Seek(-1, soFromCurrent); -end; - -const - { image descriptor bit masks } - idLocalColorTable = $80; { set if a local color table follows } - idInterlaced = $40; { set if image is interlaced } - idSort = $20; { set if color table is sorted } - idReserved = $0C; { reserved - must be set to $00 } - idColorTableSize = $07; { size of color table as above } - -constructor TGIFSubImage.Create(GIFImage: TGIFImage); -begin - inherited Create(GIFImage); - FExtensions := TGIFExtensionList.Create(GIFImage); - FColorMap := TGIFLocalColorMap.Create(self); - FImageDescriptor.Separator := bsImageDescriptor; - FImageDescriptor.Left := 0; - FImageDescriptor.Top := 0; - FImageDescriptor.Width := 0; - FImageDescriptor.Height := 0; - FImageDescriptor.PackedFields := 0; - FBitmap := nil; - FMask := 0; - FNeedMask := True; - FData := nil; - FDataSize := 0; - FTransparent := False; - FGCE := nil; - // Remember to synchronize with TGIFSubImage.Clear -end; - -destructor TGIFSubImage.Destroy; -begin - if (FGIFImage <> nil) then - FGIFImage.Images.Remove(self); - Clear; - FExtensions.Free; - FColorMap.Free; - if (FLocalPalette <> 0) then - DeleteObject(FLocalPalette); - inherited Destroy; -end; - -procedure TGIFSubImage.Clear; -begin - FExtensions.Clear; - FColorMap.Clear; - FreeImage; - Height := 0; - Width := 0; - FTransparent := False; - FGCE := nil; - FreeBitmap; - FreeMask; - // Remember to synchronize with TGIFSubImage.Create -end; - -function TGIFSubImage.GetEmpty: Boolean; -begin - Result := ((FData = nil) or (FDataSize = 0) or (Height = 0) or (Width = 0)); -end; - -function TGIFSubImage.GetPalette: HPALETTE; -begin - if (FBitmap <> nil) and (FBitmap.Palette <> 0) then - // Use bitmaps own palette if possible - Result := FBitmap.Palette - else if (FLocalPalette <> 0) then - // Or a previously exported local palette - Result := FLocalPalette - else if (Image.DoDither) then - begin - // or create a new dither palette - FLocalPalette := WebPalette; - Result := FLocalPalette; - end - else if (ColorMap.Count > 0) then - begin - // or create a new if first time - FLocalPalette := ColorMap.ExportPalette; - Result := FLocalPalette; - end else - // Use global palette if everything else fails - Result := Image.Palette; -end; - -procedure TGIFSubImage.SetPalette(Value: HPalette); -var - NeedNewBitmap : boolean; -begin - if (Value <> FLocalPalette) then - begin - // Zap old palette - if (FLocalPalette <> 0) then - DeleteObject(FLocalPalette); - // Zap bitmap unless new palette is same as bitmaps own - NeedNewBitmap := (FBitmap <> nil) and (Value <> FBitmap.Palette); - - // Use new palette - FLocalPalette := Value; - if (NeedNewBitmap) then - begin - // Need to create new bitmap and repaint - FreeBitmap; - Image.PaletteModified := True; - Image.Changed(Self); - end; - end; -end; - -procedure TGIFSubImage.NeedImage; -begin - if (FData = nil) then - NewImage; - if (FDataSize = 0) then - Error(sEmptyImage); -end; - -procedure TGIFSubImage.NewImage; -var - NewSize : longInt; -begin - FreeImage; - NewSize := Height * Width; - if (NewSize <> 0) then - begin - GetMem(FData, NewSize); - FillChar(FData^, NewSize, 0); - end else - FData := nil; - FDataSize := NewSize; -end; - -procedure TGIFSubImage.FreeImage; -begin - if (FData <> nil) then - FreeMem(FData); - FDataSize := 0; - FData := nil; -end; - -function TGIFSubImage.GetHasBitmap: boolean; -begin - Result := (FBitmap <> nil); -end; - -procedure TGIFSubImage.SetHasBitmap(Value: boolean); -begin - if (Value <> (FBitmap <> nil)) then - begin - if (Value) then - Bitmap // Referencing Bitmap will automatically create it - else - FreeBitmap; - end; -end; - -procedure TGIFSubImage.NewBitmap; -begin - FreeBitmap; - FBitmap := TBitmap.Create; -end; - -procedure TGIFSubImage.FreeBitmap; -begin - if (FBitmap <> nil) then - begin - FBitmap.Free; - FBitmap := nil; - end; -end; - -procedure TGIFSubImage.FreeMask; -begin - if (FMask <> 0) then - begin - DeleteObject(FMask); - FMask := 0; - end; - FNeedMask := True; -end; - -function TGIFSubImage.HasMask: boolean; -begin - if (FNeedMask) and (Transparent) then - begin - // Zap old bitmap - FreeBitmap; - // Create new bitmap and mask - GetBitmap; - end; - Result := (FMask <> 0); -end; - -function TGIFSubImage.GetBounds(Index: integer): WORD; -begin - case (Index) of - 1: Result := FImageDescriptor.Left; - 2: Result := FImageDescriptor.Top; - 3: Result := FImageDescriptor.Width; - 4: Result := FImageDescriptor.Height; - else - Result := 0; // To avoid compiler warnings - end; -end; - -procedure TGIFSubImage.SetBounds(Index: integer; Value: WORD); -begin - case (Index) of - 1: DoSetBounds(Value, FImageDescriptor.Top, FImageDescriptor.Width, FImageDescriptor.Height); - 2: DoSetBounds(FImageDescriptor.Left, Value, FImageDescriptor.Width, FImageDescriptor.Height); - 3: DoSetBounds(FImageDescriptor.Left, FImageDescriptor.Top, Value, FImageDescriptor.Height); - 4: DoSetBounds(FImageDescriptor.Left, FImageDescriptor.Top, FImageDescriptor.Width, Value); - end; -end; - -{$IFOPT R+} - {$DEFINE R_PLUS} - {$RANGECHECKS OFF} -{$ENDIF} -function TGIFSubImage.DoGetDitherBitmap: TBitmap; -var - ColorLookup : TColorLookup; - Ditherer : TDitherEngine; - DIBResult : TDIB; - Src : PAnsiChar; - Dst : PAnsiChar; - - Row : integer; - Color : TGIFColor; - ColMap : PColorMap; - Index : byte; - TransparentIndex : byte; - IsTransparent : boolean; - WasTransparent : boolean; - MappedTransparentIndex: AnsiChar; - - MaskBits : PAnsiChar; - MaskDest : PAnsiChar; - MaskRow : PAnsiChar; - MaskRowWidth , - MaskRowBitWidth : integer; - Bit , - RightBit : BYTE; - -begin - Result := TBitmap.Create; - try - -{$IFNDEF VER9x} - if (Width*Height > BitmapAllocationThreshold) then - SetPixelFormat(Result, pf1bit); // To reduce resource consumption of resize -{$ENDIF} - - if (Empty) then - begin - // Set bitmap width and height - Result.Width := Width; - Result.Height := Height; - - // Build and copy palette to bitmap - Result.Palette := CopyPalette(Palette); - - exit; - end; - - ColorLookup := nil; - Ditherer := nil; - DIBResult := nil; - try // Protect above resources - ColorLookup := TNetscapeColorLookup.Create(Palette); - Ditherer := TFloydSteinbergDitherer.Create(Width, ColorLookup); - // Get DIB buffer for scanline operations - // It is assumed that the source palette is the 216 color Netscape palette - DIBResult := TDIBWriter.Create(Result, pf8bit, Width, Height, Palette); - - // Determine if this image is transparent - ColMap := ActiveColorMap.Data; - IsTransparent := FNeedMask and Transparent; - WasTransparent := False; - FNeedMask := False; - TransparentIndex := 0; - MappedTransparentIndex := #0; - if (FMask = 0) and (IsTransparent) then - begin - IsTransparent := True; - TransparentIndex := GraphicControlExtension.TransparentColorIndex; - Color := ColMap[ord(TransparentIndex)]; - MappedTransparentIndex := AnsiChar(Color.Blue DIV 51 + - MulDiv(6, Color.Green, 51) + MulDiv(36, Color.Red, 51)+1); - end; - - // Allocate bit buffer for transparency mask - MaskDest := nil; - Bit := $00; - if (IsTransparent) then - begin - MaskRowWidth := ((Width+15) DIV 16) * 2; - MaskRowBitWidth := (Width+7) DIV 8; - RightBit := $01 SHL ((8 - (Width AND $0007)) AND $0007); - GetMem(MaskBits, MaskRowWidth * Height); - FillChar(MaskBits^, MaskRowWidth * Height, 0); - end else - begin - MaskBits := nil; - MaskRowWidth := 0; - MaskRowBitWidth := 0; - RightBit := $00; - end; - - try - // Process the image - Row := 0; - MaskRow := MaskBits; - Src := FData; - while (Row < Height) do - begin - if ((Row AND $1F) = 0) then - Image.Progress(Self, psRunning, MulDiv(Row, 100, Height), - False, Rect(0,0,0,0), sProgressRendering); - - Dst := DIBResult.ScanLine[Row]; - if (IsTransparent) then - begin - // Preset all pixels to transparent - FillChar(Dst^, Width, ord(MappedTransparentIndex)); - if (Ditherer.Direction = 1) then - begin - MaskDest := MaskRow; - Bit := $80; - end else - begin - MaskDest := MaskRow + MaskRowBitWidth-1; - Bit := RightBit; - end; - end; - inc(Dst, Ditherer.Column); - - while (Ditherer.Column < Ditherer.Width) and (Ditherer.Column >= 0) do - begin - Index := ord(Src^); - Color := ColMap[ord(Index)]; - - if (IsTransparent) and (Index = TransparentIndex) then - begin - MaskDest^ := AnsiChar(byte(MaskDest^) OR Bit); - WasTransparent := True; - Ditherer.NextColumn; - end else - begin - // Dither and map a single pixel - Dst^ := Ditherer.Dither(Color.Red, Color.Green, Color.Blue, - Color.Red, Color.Green, Color.Blue); - end; - - if (IsTransparent) then - begin - if (Ditherer.Direction = 1) then - begin - Bit := Bit SHR 1; - if (Bit = $00) then - begin - Bit := $80; - inc(MaskDest, 1); - end; - end else - begin - Bit := Bit SHL 1; - if (Bit = $00) then - begin - Bit := $01; - dec(MaskDest, 1); - end; - end; - end; - - inc(Src, Ditherer.Direction); - inc(Dst, Ditherer.Direction); - end; - - if (IsTransparent) then - Inc(MaskRow, MaskRowWidth); - Inc(Row); - inc(Src, Width-Ditherer.Direction); - Ditherer.NextLine; - end; - - // Transparent paint needs a mask bitmap - if (IsTransparent) and (WasTransparent) then - FMask := CreateBitmap(Width, Height, 1, 1, MaskBits); - finally - if (MaskBits <> nil) then - FreeMem(MaskBits); - end; - finally - if (ColorLookup <> nil) then - ColorLookup.Free; - if (Ditherer <> nil) then - Ditherer.Free; - if (DIBResult <> nil) then - DIBResult.Free; - end; - except - Result.Free; - raise; - end; -end; -{$IFDEF R_PLUS} - {$RANGECHECKS ON} - {$UNDEF R_PLUS} -{$ENDIF} - -function TGIFSubImage.DoGetBitmap: TBitmap; -var - ScanLineRow : Integer; - DIBResult : TDIB; - DestScanLine , - Src : PAnsiChar; - TransparentIndex : byte; - IsTransparent : boolean; - WasTransparent : boolean; - - MaskBits : PAnsiChar; - MaskDest : PAnsiChar; - MaskRow : PAnsiChar; - MaskRowWidth : integer; - Col : integer; - MaskByte : byte; - Bit : byte; -begin - Result := TBitmap.Create; - try - -{$IFNDEF VER9x} - if (Width*Height > BitmapAllocationThreshold) then - SetPixelFormat(Result, pf1bit); // To reduce resource consumption of resize -{$ENDIF} - - if (Empty) then - begin - // Set bitmap width and height - Result.Width := Width; - Result.Height := Height; - - // Build and copy palette to bitmap - Result.Palette := CopyPalette(Palette); - - exit; - end; - - // Get DIB buffer for scanline operations - DIBResult := TDIBWriter.Create(Result, pf8bit, Width, Height, Palette); - try - - // Determine if this image is transparent - IsTransparent := FNeedMask and Transparent; - WasTransparent := False; - FNeedMask := False; - TransparentIndex := 0; - if (FMask = 0) and (IsTransparent) then - begin - IsTransparent := True; - TransparentIndex := GraphicControlExtension.TransparentColorIndex; - end; - // Allocate bit buffer for transparency mask - if (IsTransparent) then - begin - MaskRowWidth := ((Width+15) DIV 16) * 2; - GetMem(MaskBits, MaskRowWidth * Height); - FillChar(MaskBits^, MaskRowWidth * Height, 0); - IsTransparent := (MaskBits <> nil); - end else - begin - MaskBits := nil; - MaskRowWidth := 0; - end; - - try - ScanLineRow := 0; - Src := FData; - MaskRow := MaskBits; - while (ScanLineRow < Height) do - begin - DestScanline := DIBResult.ScanLine[ScanLineRow]; - - if ((ScanLineRow AND $1F) = 0) then - Image.Progress(Self, psRunning, MulDiv(ScanLineRow, 100, Height), - False, Rect(0,0,0,0), sProgressRendering); - - Move(Src^, DestScanline^, Width); - Inc(ScanLineRow); - - if (IsTransparent) then - begin - Bit := $80; - MaskDest := MaskRow; - MaskByte := 0; - for Col := 0 to Width-1 do - begin - // Set a bit in the mask if the pixel is transparent - if (Src^ = AnsiChar(TransparentIndex)) then - MaskByte := MaskByte OR Bit; - - Bit := Bit SHR 1; - if (Bit = $00) then - begin - // Store a mask byte for each 8 pixels - Bit := $80; - WasTransparent := WasTransparent or (MaskByte <> 0); - MaskDest^ := AnsiChar(MaskByte); - inc(MaskDest); - MaskByte := 0; - end; - Inc(Src); - end; - // Save the last mask byte in case the width isn't divisable by 8 - if (MaskByte <> 0) then - begin - WasTransparent := True; - MaskDest^ := AnsiChar(MaskByte); - end; - Inc(MaskRow, MaskRowWidth); - end else - Inc(Src, Width); - end; - - // Transparent paint needs a mask bitmap - if (IsTransparent) and (WasTransparent) then - FMask := CreateBitmap(Width, Height, 1, 1, MaskBits); - finally - if (MaskBits <> nil) then - FreeMem(MaskBits); - end; - finally - // Free DIB buffer used for scanline operations - DIBResult.Free; - end; - except - Result.Free; - raise; - end; -end; - -{$ifdef DEBUG_RENDERPERFORMANCE} -var - ImageCount : DWORD = 0; - RenderTime : DWORD = 0; -{$endif} -function TGIFSubImage.GetBitmap: TBitmap; -var - n : integer; -{$ifdef DEBUG_RENDERPERFORMANCE} - RenderStartTime : DWORD; -{$endif} -begin -{$ifdef DEBUG_RENDERPERFORMANCE} - if (GetAsyncKeyState(VK_CONTROL) <> 0) then - begin - ShowMessage(format('Render %d images in %d mS, Rate %d mS/image (%d images/S)', - [ImageCount, RenderTime, - RenderTime DIV (ImageCount+1), - MulDiv(ImageCount, 1000, RenderTime+1)])); - end; -{$endif} - Result := FBitmap; - if (Result <> nil) or (Empty) then - Exit; - -{$ifdef DEBUG_RENDERPERFORMANCE} - inc(ImageCount); - RenderStartTime := timeGetTime; -{$endif} - try - Image.Progress(Self, psStarting, 0, False, Rect(0,0,0,0), sProgressRendering); - try - - if (Image.DoDither) then - // Create dithered bitmap - FBitmap := DoGetDitherBitmap - else - // Create "regular" bitmap - FBitmap := DoGetBitmap; - - Result := FBitmap; - - finally - if ExceptObject = nil then - n := 100 - else - n := 0; - Image.Progress(Self, psEnding, n, Image.PaletteModified, Rect(0,0,0,0), - sProgressRendering); - // Make sure new palette gets realized, in case OnProgress event didn't. - if Image.PaletteModified then - Image.Changed(Self); - end; - except - on EAbort do ; // OnProgress can raise EAbort to cancel image load - end; -{$ifdef DEBUG_RENDERPERFORMANCE} - inc(RenderTime, timeGetTime-RenderStartTime); -{$endif} -end; - -procedure TGIFSubImage.SetBitmap(Value: TBitmap); -begin - FreeBitmap; - if (Value <> nil) then - Assign(Value); -end; - -function TGIFSubImage.GetActiveColorMap: TGIFColorMap; -begin - if (ColorMap.Count > 0) or (Image.GlobalColorMap.Count = 0) then - Result := ColorMap - else - Result := Image.GlobalColorMap; -end; - -function TGIFSubImage.GetInterlaced: boolean; -begin - Result := (FImageDescriptor.PackedFields AND idInterlaced) <> 0; -end; - -procedure TGIFSubImage.SetInterlaced(Value: boolean); -begin - if (Value) then - FImageDescriptor.PackedFields := FImageDescriptor.PackedFields OR idInterlaced - else - FImageDescriptor.PackedFields := FImageDescriptor.PackedFields AND NOT(idInterlaced); -end; - -function TGIFSubImage.GetVersion: TGIFVersion; -var - v : TGIFVersion; - i : integer; -begin - if (ColorMap.Optimized) then - Result := gv89a - else - Result := inherited GetVersion; - i := 0; - while (Result < high(TGIFVersion)) and (i < FExtensions.Count) do - begin - v := FExtensions[i].Version; - if (v > Result) then - Result := v; - end; -end; - -function TGIFSubImage.GetColorResolution: integer; -begin - Result := ColorMap.BitsPerPixel-1; -end; - -function TGIFSubImage.GetBitsPerPixel: integer; -begin - Result := ColorMap.BitsPerPixel; -end; - -function TGIFSubImage.GetBoundsRect: TRect; -begin - Result := Rect(FImageDescriptor.Left, - FImageDescriptor.Top, - FImageDescriptor.Left+FImageDescriptor.Width, - FImageDescriptor.Top+FImageDescriptor.Height); -end; - -procedure TGIFSubImage.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); -var - TooLarge : boolean; - Zap : boolean; -begin - Zap := (FImageDescriptor.Width <> Width) or (FImageDescriptor.Height <> AHeight); - FImageDescriptor.Left := ALeft; - FImageDescriptor.Top := ATop; - FImageDescriptor.Width := AWidth; - FImageDescriptor.Height := AHeight; - - // Delete existing image and bitmaps if size has changed - if (Zap) then - begin - FreeBitmap; - FreeMask; - FreeImage; - // ...and allocate a new image - NewImage; - end; - - TooLarge := False; - // Set width & height if added image is larger than existing images -{$IFDEF STRICT_MOZILLA} - // From Mozilla source: - // Work around broken GIF files where the logical screen - // size has weird width or height. [...] - if (Image.Width < AWidth) or (Image.Height < AHeight) then - begin - TooLarge := True; - Image.Width := AWidth; - Image.Height := AHeight; - Left := 0; - Top := 0; - end; -{$ELSE} - if (Image.Width < ALeft+AWidth) then - begin - if (Image.Width > 0) then - begin - TooLarge := True; - Warning(gsWarning, sBadWidth) - end; - Image.Width := ALeft+AWidth; - end; - if (Image.Height < ATop+AHeight) then - begin - if (Image.Height > 0) then - begin - TooLarge := True; - Warning(gsWarning, sBadHeight) - end; - Image.Height := ATop+AHeight; - end; -{$ENDIF} - - if (TooLarge) then - Warning(gsWarning, sScreenSizeExceeded); -end; - -procedure TGIFSubImage.SetBoundsRect(const Value: TRect); -begin - DoSetBounds(Value.Left, Value.Top, Value.Right-Value.Left+1, Value.Bottom-Value.Top+1); -end; - -function TGIFSubImage.GetClientRect: TRect; -begin - Result := Rect(0, 0, FImageDescriptor.Width, FImageDescriptor.Height); -end; - -function TGIFSubImage.GetPixel(x, y: integer): BYTE; -begin - if (x < 0) or (x > Width-1) then - Error(sBadPixelCoordinates); - Result := BYTE(PAnsiChar(longInt(Scanline[y]) + x)^); -end; - -// 2006.10.09 -> -procedure TGIFSubImage.SetPixel(x, y: integer; Value: BYTE ); -begin - if (x < 0) or (x > Width-1) or (y < 0) or (y > Height-1) then - Error(sBadPixelCoordinates); - if Value >= ActiveColorMap.FCount then - Error(sBadColorIndex); -// 2008.10.19 -> -// BYTE(PChar(longInt(Scanline[y]) + x)^) := Value; - PByte(LongInt(Scanline[y]) + x)^ := Value; -// 2008.10.19 <- -end; -// 2006.10.09 <- - -function TGIFSubImage.GetScanline(y: integer): pointer; -begin - if (y < 0) or (y > Height-1) then - Error(sBadPixelCoordinates); - NeedImage; - Result := pointer(longInt(FData) + y * Width); -end; - -procedure TGIFSubImage.Prepare; -var - Pack : BYTE; -begin - Pack := FImageDescriptor.PackedFields; - if (ColorMap.Count > 0) then - begin - Pack := idLocalColorTable; - if (ColorMap.Optimized) then - Pack := Pack OR idSort; - Pack := (Pack AND NOT(idColorTableSize)) OR (ColorResolution AND idColorTableSize); - end else - Pack := Pack AND NOT(idLocalColorTable OR idSort OR idColorTableSize); - FImageDescriptor.PackedFields := Pack; -end; - -procedure TGIFSubImage.SaveToStream(Stream: TStream); -begin - FExtensions.SaveToStream(Stream); - if (Empty) then - exit; - Prepare; - Stream.Write(FImageDescriptor, sizeof(TImageDescriptor)); - ColorMap.SaveToStream(Stream); - Compress(Stream); -end; - -procedure TGIFSubImage.LoadFromStream(Stream: TStream); -var - ColorCount : integer; - b : BYTE; -begin - Clear; - FExtensions.LoadFromStream(Stream, self); - // Check for extension without image - if (Stream.Read(b, 1) <> 1) then - exit; - Stream.Seek(-1, soFromCurrent); - if (b = bsTrailer) or (b = 0) then - exit; - - ReadCheck(Stream, FImageDescriptor, sizeof(TImageDescriptor)); - - // From Mozilla source: - // Work around more broken GIF files that have zero image - // width or height - if (FImageDescriptor.Height = 0) or (FImageDescriptor.Width = 0) then - begin - FImageDescriptor.Height := Image.Height; - FImageDescriptor.Width := Image.Width; - Warning(gsWarning, sScreenSizeExceeded); - end; - - if (FImageDescriptor.PackedFields AND idLocalColorTable = idLocalColorTable) then - begin - ColorCount := 2 SHL (FImageDescriptor.PackedFields AND idColorTableSize); - if (ColorCount < 2) or (ColorCount > 256) then - Error(sImageBadColorSize); - ColorMap.LoadFromStream(Stream, ColorCount); - end; - - Decompress(Stream); - - // On-load rendering - if (GIFImageRenderOnLoad) then - // Touch bitmap to force frame to be rendered - Bitmap; -end; - -procedure TGIFSubImage.AssignTo(Dest: TPersistent); -begin - if (Dest is TBitmap) then - Dest.Assign(Bitmap) - else - inherited AssignTo(Dest); -end; - -procedure TGIFSubImage.Assign(Source: TPersistent); -var - MemoryStream : TMemoryStream; - i : integer; - PixelFormat : TPixelFormat; - DIBSource : TDIB; - ABitmap : TBitmap; - - procedure Import8Bit(Dest: PAnsiChar); - var - y : integer; - begin - // Copy colormap -{$ifdef VER10_PLUS} - if (FBitmap.HandleType = bmDIB) then - FColorMap.ImportDIBColors(FBitmap.Canvas.Handle) - else -{$ENDIF} - FColorMap.ImportPalette(FBitmap.Palette); - // Copy pixels - for y := 0 to Height-1 do - begin - if ((y AND $1F) = 0) then - Image.Progress(Self, psRunning, MulDiv(y, 100, Height), False, Rect(0,0,0,0), sProgressConverting); - Move(DIBSource.Scanline[y]^, Dest^, Width); - inc(Dest, Width); - end; - end; - - procedure Import4Bit(Dest: PAnsiChar); - var - x, y : integer; - Scanline : PAnsiChar; - begin - // Copy colormap - FColorMap.ImportPalette(FBitmap.Palette); - // Copy pixels - for y := 0 to Height-1 do - begin - if ((y AND $1F) = 0) then - Image.Progress(Self, psRunning, MulDiv(y, 100, Height), False, Rect(0,0,0,0), sProgressConverting); - ScanLine := DIBSource.Scanline[y]; - for x := 0 to Width-1 do - begin - if (x AND $01 = 0) then -// 2008.10.19 -> -// Dest^ := chr(ord(ScanLine^) SHR 4) - Dest^ := AnsiChar(ord(ScanLine^) SHR 4) -// 2008.10.19 <- - else - begin -// 2008.10.19 -> -// Dest^ := chr(ord(ScanLine^) AND $0F); - Dest^ := AnsiChar(ord(ScanLine^) AND $0F); -// 2008.10.19 <- - inc(ScanLine); - end; - inc(Dest); - end; - end; - end; - - procedure Import1Bit(Dest: PAnsiChar); - var - x, y : integer; - Scanline : PAnsiChar; - Bit : integer; - Byte : integer; - begin - // Copy colormap - FColorMap.ImportPalette(FBitmap.Palette); - // Copy pixels - for y := 0 to Height-1 do - begin - if ((y AND $1F) = 0) then - Image.Progress(Self, psRunning, MulDiv(y, 100, Height), False, Rect(0,0,0,0), sProgressConverting); - ScanLine := DIBSource.Scanline[y]; - x := Width; - Bit := 0; - Byte := 0; // To avoid compiler warning - while (x > 0) do - begin - if (Bit = 0) then - begin - Bit := 8; - Byte := ord(ScanLine^); - inc(Scanline); - end; -// 2008.10.19 -> -// Dest^ := chr((Byte AND $80) SHR 7); - Dest^ := AnsiChar((Byte AND $80) SHR 7); -// 2008.10.19 <- - Byte := Byte SHL 1; - inc(Dest); - dec(Bit); - dec(x); - end; - end; - end; - - procedure Import24Bit(Dest: PAnsiChar); - type - TCacheEntry = record - Color : TColor; - Index : integer; - end; - const - // Size of palette cache. Must be 2^n. - // The cache holds the palette index of the last "CacheSize" colors - // processed. Hopefully the cache can speed things up a bit... Initial - // testing shows that this is indeed the case at least for non-dithered - // bitmaps. - // All the same, a small hash table would probably be much better. - CacheSize = 8; - var - i : integer; - Cache : array[0..CacheSize-1] of TCacheEntry; - LastEntry : integer; - Scanline : PRGBTriple; - Pixel : TColor; - RGBTriple : TRGBTriple absolute Pixel; - x, y : integer; - ColorMap : PColorMap; - t : byte; - label - NextPixel; - begin - for i := 0 to CacheSize-1 do - Cache[i].Index := -1; - LastEntry := 0; - - // Copy all pixels and build colormap - for y := 0 to Height-1 do - begin - if ((y AND $1F) = 0) then - Image.Progress(Self, psRunning, MulDiv(y, 100, Height), False, Rect(0,0,0,0), sProgressConverting); - ScanLine := DIBSource.Scanline[y]; - for x := 0 to Width-1 do - begin - Pixel := 0; - RGBTriple := Scanline^; - // Scan cache for color from most recently processed color to last - // recently processed. This is done because TColorMap.AddUnique is very slow. - i := LastEntry; - repeat - if (Cache[i].Index = -1) then - break; - if (Cache[i].Color = Pixel) then - begin -// 2008.10.19 -> -// Dest^ := chr(Cache[i].Index); - Dest^ := AnsiChar(Cache[i].Index); -// 2008.10.19 <- - LastEntry := i; - goto NextPixel; - end; - if (i = 0) then - i := CacheSize-1 - else - dec(i); - until (i = LastEntry); - // Color not found in cache, do it the slow way instead -// 2008.10.19 -> -// Dest^ := chr(FColorMap.AddUnique(Pixel)); - Dest^ := AnsiChar(FColorMap.AddUnique(Pixel)); -// 2008.10.19 <- - // Add color and index to cache - LastEntry := (LastEntry + 1) AND (CacheSize-1); - Cache[LastEntry].Color := Pixel; - Cache[LastEntry].Index := ord(Dest^); - - NextPixel: - Inc(Dest); - Inc(Scanline); - end; - end; - // Convert colors in colormap from BGR to RGB - ColorMap := FColorMap.Data; - i := FColorMap.Count; - while (i > 0) do - begin - t := ColorMap^[0].Red; - ColorMap^[0].Red := ColorMap^[0].Blue; - ColorMap^[0].Blue := t; - inc(integer(ColorMap), sizeof(TGIFColor)); - dec(i); - end; - end; - - procedure ImportViaDraw(ABitmap: TBitmap; Graphic: TGraphic); - begin - ABitmap.Height := Graphic.Height; - ABitmap.Width := Graphic.Width; - - // Note: Disable the call to SafeSetPixelFormat below to import - // in max number of colors with the risk of having to use - // TCanvas.Pixels to do it (very slow). - - // Make things a little easier for TGIFSubImage.Assign by converting - // pfDevice to a more import friendly format -{$ifdef SLOW_BUT_SAFE} - SafeSetPixelFormat(ABitmap, pf8bit); -{$else} -{$ifndef VER9x} - SetPixelFormat(ABitmap, pf24bit); -{$endif} -{$endif} - ABitmap.Canvas.Draw(0, 0, Graphic); - end; - - procedure AddMask(Mask: TBitmap); - var - DIBReader : TDIBReader; - TransparentIndex : integer; - i , - j : integer; - GIFPixel , - MaskPixel : PAnsiChar; - WasTransparent : boolean; - GCE : TGIFGraphicControlExtension; - begin - // Optimize colormap to make room for transparent color - ColorMap.Optimize; - // Can't make transparent if no color or colormap full - if (ColorMap.Count = 0) or (ColorMap.Count = 256) then - exit; - - // Add the transparent color to the color map - TransparentIndex := ColorMap.Add(TColor(0)); - WasTransparent := False; - - DIBReader := TDIBReader.Create(Mask, pf8bit); - try - for i := 0 to Height-1 do - begin - MaskPixel := DIBReader.Scanline[i]; - GIFPixel := Scanline[i]; - for j := 0 to Width-1 do - begin - // Change all unmasked pixels to transparent - if (MaskPixel^ <> #0) then - begin -// 2008.10.19 -> -// GIFPixel^ := chr(TransparentIndex); - GIFPixel^ := AnsiChar(TransparentIndex); -// 2008.10.19 <- - WasTransparent := True; - end; - inc(MaskPixel); - inc(GIFPixel); - end; - end; - finally - DIBReader.Free; - end; - - // Add a Graphic Control Extension if any part of the mask was transparent - if (WasTransparent) then - begin - GCE := TGIFGraphicControlExtension.Create(self); - GCE.Transparent := True; - GCE.TransparentColorIndex := TransparentIndex; - Extensions.Add(GCE); - end else - // Otherwise removed the transparency color since it wasn't used - ColorMap.Delete(TransparentIndex); - end; - - procedure AddMaskOnly(hMask: hBitmap); - var - Mask : TBitmap; - begin - if (hMask = 0) then - exit; - - // Encapsulate the mask - Mask := TBitmap.Create; - try -// Mask.Handle := hMask; // 2003.08.04 - Mask.Handle := Windows.CopyImage(hMask, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG); // 2003.08.04 - AddMask(Mask); - finally -// Mask.ReleaseHandle; // 2003.08.04 - Mask.Free; - end; - end; - - procedure AddIconMask(Icon: TIcon); - var - IconInfo : TIconInfo; - begin - if (not GetIconInfo(Icon.Handle, IconInfo)) then - exit; - - // Extract the icon mask - AddMaskOnly(IconInfo.hbmMask); - end; - - procedure AddMetafileMask(Metafile: TMetaFile); - var - Mask1 , - Mask2 : TBitmap; - - procedure DrawMetafile(ABitmap: TBitmap; Background: TColor); - begin - ABitmap.Width := Metafile.Width; - ABitmap.Height := Metafile.Height; -{$ifndef VER9x} - SetPixelFormat(ABitmap, pf24bit); -{$endif} - ABitmap.Canvas.Brush.Color := Background; - ABitmap.Canvas.Brush.Style := bsSolid; - ABitmap.Canvas.FillRect(ABitmap.Canvas.ClipRect); - ABitmap.Canvas.Draw(0,0, Metafile); - end; - - begin - // Create the metafile mask - Mask1 := TBitmap.Create; - try - Mask2 := TBitmap.Create; - try - DrawMetafile(Mask1, clWhite); - DrawMetafile(Mask2, clBlack); - Mask1.Canvas.CopyMode := cmSrcInvert; - Mask1.Canvas.Draw(0,0, Mask2); - AddMask(Mask1); - finally - Mask2.Free; - end; - finally - Mask1.Free; - end; - end; - -begin - if (Source = self) then - exit; - if (Source = nil) then - begin - Clear; - end else - // - // TGIFSubImage import - // - if (Source is TGIFSubImage) then - begin - // Zap existing colormap, extensions and bitmap - Clear; - if (TGIFSubImage(Source).Empty) then - exit; - // Copy source data - FImageDescriptor := TGIFSubImage(Source).FImageDescriptor; - FTransparent := TGIFSubImage(Source).Transparent; - // Copy image data - NewImage; - if (FData <> nil) and (TGIFSubImage(Source).Data <> nil) then - Move(TGIFSubImage(Source).Data^, FData^, FDataSize); - // Copy palette - FColorMap.Assign(TGIFSubImage(Source).ColorMap); - // Copy extensions - if (TGIFSubImage(Source).Extensions.Count > 0) then - begin - MemoryStream := TMemoryStream.Create; - try - TGIFSubImage(Source).Extensions.SaveToStream(MemoryStream); - MemoryStream.Seek(0, soFromBeginning); - Extensions.LoadFromStream(MemoryStream, Self); - finally - MemoryStream.Free; - end; - end; - - // Copy bitmap representation - // (Not really nescessary but improves performance if the bitmap is needed - // later on) - if (TGIFSubImage(Source).HasBitmap) then - begin - NewBitmap; - FBitmap.Assign(TGIFSubImage(Source).Bitmap); - end; - end else - // - // Bitmap import - // - if (Source is TBitmap) then - begin - // Zap existing colormap, extensions and bitmap - Clear; - if (TBitmap(Source).Empty) then - exit; - - Width := TBitmap(Source).Width; - Height := TBitmap(Source).Height; - - PixelFormat := GetPixelFormat(TBitmap(Source)); -{$ifdef VER9x} - // Delphi 2 TBitmaps are always DDBs. This means that if a 24 bit - // bitmap is loaded in 8 bit device mode, TBitmap.PixelFormat will - // be pf8bit, but TBitmap.Palette will be 0! - if (TBitmap(Source).Palette = 0) then - PixelFormat := pfDevice; -{$endif} - if (PixelFormat > pf8bit) or (PixelFormat = pfDevice) then - begin - // Convert image to 8 bits/pixel or less - FBitmap := ReduceColors(TBitmap(Source), Image.ColorReduction, - Image.DitherMode, Image.ReductionBits, 0); - PixelFormat := GetPixelFormat(FBitmap); - end else - begin - // Create new bitmap and copy - NewBitmap; - FBitmap.Assign(TBitmap(Source)); - end; - - // Allocate new buffer - NewImage; - - Image.Progress(Self, psStarting, 0, False, Rect(0,0,0,0), sProgressConverting); - try -{$ifdef VER9x} - // This shouldn't happen, but better safe... - if (FBitmap.Palette = 0) then - PixelFormat := pf24bit; -{$endif} - if (not(PixelFormat in [pf1bit, pf4bit, pf8bit, pf24bit])) then - PixelFormat := pf24bit; - DIBSource := TDIBReader.Create(FBitmap, PixelFormat); - try - // Copy pixels - case (PixelFormat) of - pf8bit: Import8Bit(Fdata); - pf4bit: Import4Bit(Fdata); - pf1bit: Import1Bit(Fdata); - else -// Error(sUnsupportedBitmap); - Import24Bit(Fdata); - end; - - finally - DIBSource.Free; - end; - -{$ifdef VER10_PLUS} - // Add mask for transparent bitmaps - if (TBitmap(Source).Transparent) then - AddMaskOnly(TBitmap(Source).MaskHandle); -{$endif} - - finally - if ExceptObject = nil then - i := 100 - else - i := 0; - Image.Progress(Self, psEnding, i, Image.PaletteModified, Rect(0,0,0,0), sProgressConverting); - end; - end else - // - // TGraphic import - // - if (Source is TGraphic) then - begin - // Zap existing colormap, extensions and bitmap - Clear; - if (TGraphic(Source).Empty) then - exit; - - ABitmap := TBitmap.Create; - try - // Import TIcon and TMetafile by drawing them onto a bitmap... - // ...and then importing the bitmap recursively - if (Source is TIcon) or (Source is TMetafile) then - begin - try - ImportViaDraw(ABitmap, TGraphic(Source)) - except - // If import via TCanvas.Draw fails (which it shouldn't), we try the - // Assign mechanism instead - ABitmap.Assign(Source); - end; - end else - try - ABitmap.Assign(Source); - except - // If automatic conversion to bitmap fails, we try and draw the - // graphic on the bitmap instead - ImportViaDraw(ABitmap, TGraphic(Source)); - end; - // Convert the bitmap to a GIF frame recursively - Assign(ABitmap); - finally - ABitmap.Free; - end; - - // Import transparency mask - if (Source is TIcon) then - AddIconMask(TIcon(Source)); - if (Source is TMetaFile) then - AddMetafileMask(TMetaFile(Source)); - - end else - // - // TPicture import - // - if (Source is TPicture) then - begin - // Recursively import TGraphic - Assign(TPicture(Source).Graphic); - end else - // Unsupported format - fall back to Source.AssignTo - inherited Assign(Source); -end; - -// Copied from D3 graphics.pas -// Fixed by Brian Lowe of Acro Technology Inc. 30Jan98 -function TransparentStretchBlt(DstDC: HDC; DstX, DstY, DstW, DstH: Integer; - SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; MaskDC: HDC; MaskX, - MaskY: Integer): Boolean; -const - ROP_DstCopy = $00AA0029; -var - MemDC , - OrMaskDC : HDC; - MemBmp , - OrMaskBmp : HBITMAP; - Save , - OrMaskSave : THandle; - crText, crBack : TColorRef; - SavePal : HPALETTE; - -begin - Result := True; - if (Win32Platform = VER_PLATFORM_WIN32_NT) and (SrcW = DstW) and (SrcH = DstH) then - begin - MemBmp := GDICheck(CreateCompatibleBitmap(SrcDC, 1, 1)); - MemBmp := SelectObject(MaskDC, MemBmp); - try - MaskBlt(DstDC, DstX, DstY, DstW, DstH, SrcDC, SrcX, SrcY, MemBmp, MaskX, - MaskY, MakeRop4(ROP_DstCopy, SrcCopy)); - finally - MemBmp := SelectObject(MaskDC, MemBmp); - DeleteObject(MemBmp); - end; - Exit; - end; - - SavePal := 0; - MemDC := GDICheck(CreateCompatibleDC(DstDC)); - try - { Color bitmap for combining OR mask with source bitmap } - MemBmp := GDICheck(CreateCompatibleBitmap(DstDC, SrcW, SrcH)); - try - Save := SelectObject(MemDC, MemBmp); - try - { This bitmap needs the size of the source but DC of the dest } - OrMaskDC := GDICheck(CreateCompatibleDC(DstDC)); - try - { Need a monochrome bitmap for OR mask!! } - OrMaskBmp := GDICheck(CreateBitmap(SrcW, SrcH, 1, 1, nil)); - try - OrMaskSave := SelectObject(OrMaskDC, OrMaskBmp); - try - - // OrMask := 1 - // Original: BitBlt(OrMaskDC, SrcX, SrcY, SrcW, SrcH, OrMaskDC, SrcX, SrcY, WHITENESS); - // Replacement, but not needed: PatBlt(OrMaskDC, SrcX, SrcY, SrcW, SrcH, WHITENESS); - // OrMask := OrMask XOR Mask - // Not needed: BitBlt(OrMaskDC, SrcX, SrcY, SrcW, SrcH, MaskDC, SrcX, SrcY, SrcInvert); - // OrMask := NOT Mask - BitBlt(OrMaskDC, SrcX, SrcY, SrcW, SrcH, MaskDC, SrcX, SrcY, NotSrcCopy); - - // Retrieve source palette (with dummy select) - SavePal := SelectPalette(SrcDC, SystemPalette16, False); - // Restore source palette - SelectPalette(SrcDC, SavePal, False); - // Select source palette into memory buffer - if SavePal <> 0 then - SavePal := SelectPalette(MemDC, SavePal, True) - else - SavePal := SelectPalette(MemDC, SystemPalette16, True); - RealizePalette(MemDC); - - // Mem := OrMask - BitBlt(MemDC, SrcX, SrcY, SrcW, SrcH, OrMaskDC, SrcX, SrcY, SrcCopy); - // Mem := Mem AND Src -{$IFNDEF GIF_TESTMASK} // Define GIF_TESTMASK if you want to know what it does... - BitBlt(MemDC, SrcX, SrcY, SrcW, SrcH, SrcDC, SrcX, SrcY, SrcAnd); -{$ELSE} - StretchBlt(DstDC, DstX, DstY, DstW DIV 2, DstH, MemDC, SrcX, SrcY, SrcW, SrcH, SrcCopy); - StretchBlt(DstDC, DstX+DstW DIV 2, DstY, DstW DIV 2, DstH, SrcDC, SrcX, SrcY, SrcW, SrcH, SrcCopy); - exit; -{$ENDIF} - finally - if (OrMaskSave <> 0) then - SelectObject(OrMaskDC, OrMaskSave); - end; - finally - DeleteObject(OrMaskBmp); - end; - finally - DeleteDC(OrMaskDC); - end; - - crText := SetTextColor(DstDC, $00000000); - crBack := SetBkColor(DstDC, $00FFFFFF); - - { All color rendering is done at 1X (no stretching), - then final 2 masks are stretched to dest DC } - // Neat trick! - // Dst := Dst AND Mask - StretchBlt(DstDC, DstX, DstY, DstW, DstH, MaskDC, SrcX, SrcY, SrcW, SrcH, SrcAnd); - // Dst := Dst OR Mem - StretchBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, SrcX, SrcY, SrcW, SrcH, SrcPaint); - - SetTextColor(DstDC, crText); - SetTextColor(DstDC, crBack); - - finally - if (Save <> 0) then - SelectObject(MemDC, Save); - end; - finally - DeleteObject(MemBmp); - end; - finally - if (SavePal <> 0) then - SelectPalette(MemDC, SavePal, False); - DeleteDC(MemDC); - end; -end; - -procedure TGIFSubImage.Draw(ACanvas: TCanvas; const Rect: TRect; - DoTransparent, DoTile: boolean); -begin - if (DoTile) then - StretchDraw(ACanvas, Rect, DoTransparent, DoTile) - else - StretchDraw(ACanvas, ScaleRect(Rect), DoTransparent, DoTile); -end; - -type - // Dummy class used to gain access to protected method TCanvas.Changed - TChangableCanvas = class(TCanvas) - end; - -procedure TGIFSubImage.StretchDraw(ACanvas: TCanvas; const Rect: TRect; - DoTransparent, DoTile: boolean); -var - MaskDC : HDC; - Save : THandle; - Tile : TRect; -{$ifdef DEBUG_DRAWPERFORMANCE} - ImageCount , - TimeStart , - TimeStop : DWORD; -{$endif} - -begin -{$ifdef DEBUG_DRAWPERFORMANCE} - TimeStart := timeGetTime; - ImageCount := 0; -{$endif} - if (DoTransparent) and (Transparent) and (HasMask) then - begin - // Draw transparent using mask - Save := 0; - MaskDC := 0; - try - MaskDC := GDICheck(CreateCompatibleDC(0)); - Save := SelectObject(MaskDC, FMask); - - if (DoTile) then - begin - Tile.Left := Rect.Left+Left; - Tile.Right := Tile.Left + Width; - while (Tile.Left < Rect.Right) do - begin - Tile.Top := Rect.Top+Top; - Tile.Bottom := Tile.Top + Height; - while (Tile.Top < Rect.Bottom) do - begin - TransparentStretchBlt(ACanvas.Handle, Tile.Left, Tile.Top, Width, Height, - Bitmap.Canvas.Handle, 0, 0, Width, Height, MaskDC, 0, 0); - Tile.Top := Tile.Top + Image.Height; - Tile.Bottom := Tile.Bottom + Image.Height; -{$ifdef DEBUG_DRAWPERFORMANCE} - inc(ImageCount); -{$endif} - end; - Tile.Left := Tile.Left + Image.Width; - Tile.Right := Tile.Right + Image.Width; - end; - end else - TransparentStretchBlt(ACanvas.Handle, Rect.Left, Rect.Top, - Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, - Bitmap.Canvas.Handle, 0, 0, Width, Height, MaskDC, 0, 0); - - // Since we are not using any of the TCanvas functions (only handle) - // we need to fire the TCanvas.Changed method "manually". - TChangableCanvas(ACanvas).Changed; - - finally - if (Save <> 0) then - SelectObject(MaskDC, Save); - if (MaskDC <> 0) then - DeleteDC(MaskDC); - end; - end else - begin - if (DoTile) then - begin - Tile.Left := Rect.Left+Left; - Tile.Right := Tile.Left + Width; - while (Tile.Left < Rect.Right) do - begin - Tile.Top := Rect.Top+Top; - Tile.Bottom := Tile.Top + Height; - while (Tile.Top < Rect.Bottom) do - begin - ACanvas.StretchDraw(Tile, Bitmap); - Tile.Top := Tile.Top + Image.Height; - Tile.Bottom := Tile.Bottom + Image.Height; -{$ifdef DEBUG_DRAWPERFORMANCE} - inc(ImageCount); -{$endif} - end; - Tile.Left := Tile.Left + Image.Width; - Tile.Right := Tile.Right + Image.Width; - end; - end else - ACanvas.StretchDraw(Rect, Bitmap); - end; -{$ifdef DEBUG_DRAWPERFORMANCE} - if (GetAsyncKeyState(VK_CONTROL) <> 0) then - begin - TimeStop := timeGetTime; - ShowMessage(format('Draw %d images in %d mS, Rate %d images/mS (%d images/S)', - [ImageCount, TimeStop-TimeStart, - ImageCount DIV (TimeStop-TimeStart+1), - MulDiv(ImageCount, 1000, TimeStop-TimeStart+1)])); - end; -{$endif} -end; - -// Given a destination rect (DestRect) calculates the -// area covered by this sub image -function TGIFSubImage.ScaleRect(DestRect: TRect): TRect; -var - HeightMul , - HeightDiv : integer; - WidthMul , - WidthDiv : integer; -begin - HeightDiv := Image.Height; - HeightMul := DestRect.Bottom-DestRect.Top; - WidthDiv := Image.Width; - WidthMul := DestRect.Right-DestRect.Left; - - Result.Left := DestRect.Left + muldiv(Left, WidthMul, WidthDiv); - Result.Top := DestRect.Top + muldiv(Top, HeightMul, HeightDiv); - Result.Right := DestRect.Left + muldiv(Left+Width, WidthMul, WidthDiv); - Result.Bottom := DestRect.Top + muldiv(Top+Height, HeightMul, HeightDiv); -end; - -procedure TGIFSubImage.Crop; -var - TransparentColorIndex : byte; - CropLeft , - CropTop , - CropRight , - CropBottom : integer; - WasTransparent : boolean; - i : integer; - NewSize : integer; - NewData : PAnsiChar; - NewWidth , - NewHeight : integer; - pSource , - pDest : PAnsiChar; -begin - if (Empty) or (not Transparent) then - exit; - TransparentColorIndex := GraphicControlExtension.TransparentColorIndex; - CropLeft := 0; - CropRight := Width - 1; - CropTop := 0; - CropBottom := Height - 1; - // Find left edge - WasTransparent := True; - while (CropLeft <= CropRight) and (WasTransparent) do - begin - for i := CropTop to CropBottom do - if (Pixels[CropLeft, i] <> TransparentColorIndex) then - begin - WasTransparent := False; - break; - end; - if (WasTransparent) then - inc(CropLeft); - end; - // Find right edge - WasTransparent := True; - while (CropLeft <= CropRight) and (WasTransparent) do - begin - for i := CropTop to CropBottom do - if (pixels[CropRight, i] <> TransparentColorIndex) then - begin - WasTransparent := False; - break; - end; - if (WasTransparent) then - dec(CropRight); - end; - if (CropLeft <= CropRight) then - begin - // Find top edge - WasTransparent := True; - while (CropTop <= CropBottom) and (WasTransparent) do - begin - for i := CropLeft to CropRight do - if (pixels[i, CropTop] <> TransparentColorIndex) then - begin - WasTransparent := False; - break; - end; - if (WasTransparent) then - inc(CropTop); - end; - // Find bottom edge - WasTransparent := True; - while (CropTop <= CropBottom) and (WasTransparent) do - begin - for i := CropLeft to CropRight do - if (pixels[i, CropBottom] <> TransparentColorIndex) then - begin - WasTransparent := False; - break; - end; - if (WasTransparent) then - dec(CropBottom); - end; - end; - - if (CropLeft > CropRight) or (CropTop > CropBottom) then - begin - // Cropped to nothing - frame is invisible - Clear; - end else - begin - // Crop frame - move data - NewWidth := CropRight - CropLeft + 1; - Newheight := CropBottom - CropTop + 1; - NewSize := NewWidth * NewHeight; - GetMem(NewData, NewSize); - pSource := PAnsiChar(integer(FData) + CropTop * Width + CropLeft); - pDest := NewData; - for i := 0 to NewHeight-1 do - begin - Move(pSource^, pDest^, NewWidth); - inc(pSource, Width); - inc(pDest, NewWidth); - end; - FreeImage; - FData := NewData; - FDataSize := NewSize; - inc(FImageDescriptor.Left, CropLeft); - inc(FImageDescriptor.Top, CropTop); - FImageDescriptor.Width := NewWidth; - FImageDescriptor.Height := NewHeight; - FreeBitmap; - FreeMask - end; -end; - -procedure TGIFSubImage.Merge(Previous: TGIFSubImage); -var - SourceIndex , - DestIndex : byte; - SourceTransparent : boolean; - NeedTransparentColorIndex: boolean; - PreviousRect , - ThisRect , - MergeRect : TRect; - PreviousY , - X , - Y : integer; - pSource , - pDest : PAnsiChar; - pSourceMap , - pDestMap : PColorMap; - GCE : TGIFGraphicControlExtension; - - function CanMakeTransparent: boolean; - begin - // Is there a local color map... - if (ColorMap.Count > 0) then - // ...and is there room in it? - Result := (ColorMap.Count < 256) - // Is there a global color map... - else if (Image.GlobalColorMap.Count > 0) then - // ...and is there room in it? - Result := (Image.GlobalColorMap.Count < 256) - else - Result := False; - end; - - function GetTransparentColorIndex: byte; - var - i : integer; - begin - if (ColorMap.Count > 0) then - begin - // Get the transparent color from the local color map - Result := ColorMap.Add(TColor(0)); - end else - begin - // Are any other frames using the global color map for transparency - for i := 0 to Image.Images.Count-1 do - if (Image.Images[i] <> self) and (Image.Images[i].Transparent) and - (Image.Images[i].ColorMap.Count = 0) then - begin - // Use the same transparency color as the other frame - Result := Image.Images[i].GraphicControlExtension.TransparentColorIndex; - exit; - end; - // Get the transparent color from the global color map - Result := Image.GlobalColorMap.Add(TColor(0)); - end; - end; - -begin - // Determine if it is possible to merge this frame - if (Empty) or (Previous = nil) or (Previous.Empty) or - ((Previous.GraphicControlExtension <> nil) and - (Previous.GraphicControlExtension.Disposal in [dmBackground, dmPrevious])) then - exit; - - PreviousRect := Previous.BoundsRect; - ThisRect := BoundsRect; - - // Cannot merge unless the frames intersect - if (not IntersectRect(MergeRect, PreviousRect, ThisRect)) then - exit; - - // If the frame isn't already transparent, determine - // if it is possible to make it so - if (Transparent) then - begin - DestIndex := GraphicControlExtension.TransparentColorIndex; - NeedTransparentColorIndex := False; - end else - begin - if (not CanMakeTransparent) then - exit; - DestIndex := 0; // To avoid compiler warning - NeedTransparentColorIndex := True; - end; - - SourceTransparent := Previous.Transparent; - if (SourceTransparent) then - SourceIndex := Previous.GraphicControlExtension.TransparentColorIndex - else - SourceIndex := 0; // To avoid compiler warning - - PreviousY := MergeRect.Top - Previous.Top; - - pSourceMap := Previous.ActiveColorMap.Data; - pDestMap := ActiveColorMap.Data; - - for Y := MergeRect.Top - Top to MergeRect.Bottom - Top-1 do - begin - pSource := PAnsiChar(integer(Previous.Scanline[PreviousY]) + MergeRect.Left - Previous.Left); - pDest := PAnsiChar(integer(Scanline[Y]) + MergeRect.Left - Left); - - for X := MergeRect.Left to MergeRect.Right-1 do - begin - // Ignore pixels if either this frame's or the previous frame's pixel is transparent - if ( - not( - ((not NeedTransparentColorIndex) and (pDest^ = AnsiChar(DestIndex))) or - ((SourceTransparent) and (pSource^ = AnsiChar(SourceIndex))) - ) - ) and ( - // Replace same colored pixels with transparency - ((pDestMap = pSourceMap) and (pDest^ = pSource^)) or - (CompareMem(@(pDestMap^[ord(pDest^)]), @(pSourceMap^[ord(pSource^)]), sizeof(TGIFColor))) - ) then - begin - if (NeedTransparentColorIndex) then - begin - NeedTransparentColorIndex := False; - DestIndex := GetTransparentColorIndex; - end; - pDest^ := AnsiChar(DestIndex); - end; - inc(pDest); - inc(pSource); - end; - inc(PreviousY); - end; - - (* - ** Create a GCE if the frame wasn't already transparent and any - ** pixels were made transparent - *) - if (not Transparent) and (not NeedTransparentColorIndex) then - begin - if (GraphicControlExtension = nil) then - begin - GCE := TGIFGraphicControlExtension.Create(self); - Extensions.Add(GCE); - end else - GCE := GraphicControlExtension; - GCE.Transparent := True; - GCE.TransparentColorIndex := DestIndex; - end; - - FreeBitmap; - FreeMask -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFTrailer -// -//////////////////////////////////////////////////////////////////////////////// -procedure TGIFTrailer.SaveToStream(Stream: TStream); -begin - WriteByte(Stream, bsTrailer); -end; - -procedure TGIFTrailer.LoadFromStream(Stream: TStream); -var - b : BYTE; -begin - if (Stream.Read(b, 1) <> 1) then - exit; - if (b <> bsTrailer) then - Warning(gsWarning, sBadTrailer); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFExtension registration database -// -//////////////////////////////////////////////////////////////////////////////// -type - TExtensionLeadIn = packed record - Introducer: byte; { always $21 } - ExtensionLabel: byte; - end; - - PExtRec = ^TExtRec; - TExtRec = record - ExtClass: TGIFExtensionClass; - ExtLabel: BYTE; - end; - - TExtensionList = class(TList) - public - constructor Create; - destructor Destroy; override; - procedure Add(eLabel: BYTE; eClass: TGIFExtensionClass); - function FindExt(eLabel: BYTE): TGIFExtensionClass; - procedure Remove(eClass: TGIFExtensionClass); - end; - -constructor TExtensionList.Create; -begin - inherited Create; - Add(bsPlainTextExtension, TGIFTextExtension); - Add(bsGraphicControlExtension, TGIFGraphicControlExtension); - Add(bsCommentExtension, TGIFCommentExtension); - Add(bsApplicationExtension, TGIFApplicationExtension); -end; - -destructor TExtensionList.Destroy; -var - I: Integer; -begin - for I := 0 to Count-1 do - Dispose(PExtRec(Items[I])); - inherited Destroy; -end; - -procedure TExtensionList.Add(eLabel: BYTE; eClass: TGIFExtensionClass); -var - NewRec: PExtRec; -begin - New(NewRec); - with NewRec^ do - begin - ExtLabel := eLabel; - ExtClass := eClass; - end; - inherited Add(NewRec); -end; - -function TExtensionList.FindExt(eLabel: BYTE): TGIFExtensionClass; -var - I: Integer; -begin - for I := Count-1 downto 0 do - with PExtRec(Items[I])^ do - if ExtLabel = eLabel then - begin - Result := ExtClass; - Exit; - end; - Result := nil; -end; - -procedure TExtensionList.Remove(eClass: TGIFExtensionClass); -var - I: Integer; - P: PExtRec; -begin - for I := Count-1 downto 0 do - begin - P := PExtRec(Items[I]); - if P^.ExtClass.InheritsFrom(eClass) then - begin - Dispose(P); - Delete(I); - end; - end; -end; - -var - ExtensionList: TExtensionList = nil; - -function GetExtensionList: TExtensionList; -begin - if (ExtensionList = nil) then - ExtensionList := TExtensionList.Create; - Result := ExtensionList; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFExtension -// -//////////////////////////////////////////////////////////////////////////////// -function TGIFExtension.GetVersion: TGIFVersion; -begin - Result := gv89a; -end; - -class procedure TGIFExtension.RegisterExtension(eLabel: BYTE; eClass: TGIFExtensionClass); -begin - GetExtensionList.Add(eLabel, eClass); -end; - -class function TGIFExtension.FindExtension(Stream: TStream): TGIFExtensionClass; -var - eLabel : BYTE; - SubClass : TGIFExtensionClass; - Pos : LongInt; -begin - Pos := Stream.Position; - if (Stream.Read(eLabel, 1) <> 1) then - begin - Result := nil; - exit; - end; - Result := GetExtensionList.FindExt(eLabel); - while (Result <> nil) do - begin - SubClass := Result.FindSubExtension(Stream); - if (SubClass = Result) then - break; - Result := SubClass; - end; - Stream.Position := Pos; -end; - -class function TGIFExtension.FindSubExtension(Stream: TStream): TGIFExtensionClass; -begin - Result := self; -end; - -constructor TGIFExtension.Create(ASubImage: TGIFSubImage); -begin - inherited Create(ASubImage.Image); - FSubImage := ASubImage; -end; - -destructor TGIFExtension.Destroy; -begin - if (FSubImage <> nil) then - FSubImage.Extensions.Remove(self); - inherited Destroy; -end; - -procedure TGIFExtension.SaveToStream(Stream: TStream); -var - ExtensionLeadIn : TExtensionLeadIn; -begin - ExtensionLeadIn.Introducer := bsExtensionIntroducer; - ExtensionLeadIn.ExtensionLabel := ExtensionType; - Stream.Write(ExtensionLeadIn, sizeof(ExtensionLeadIn)); -end; - -function TGIFExtension.DoReadFromStream(Stream: TStream): TGIFExtensionType; -var - ExtensionLeadIn : TExtensionLeadIn; -begin - ReadCheck(Stream, ExtensionLeadIn, sizeof(ExtensionLeadIn)); - if (ExtensionLeadIn.Introducer <> bsExtensionIntroducer) then - Error(sBadExtensionLabel); - Result := ExtensionLeadIn.ExtensionLabel; -end; - -procedure TGIFExtension.LoadFromStream(Stream: TStream); -begin - // Seek past lead-in - // Stream.Seek(sizeof(TExtensionLeadIn), soFromCurrent); - if (DoReadFromStream(Stream) <> ExtensionType) then - Error(sBadExtensionInstance); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFGraphicControlExtension -// -//////////////////////////////////////////////////////////////////////////////// -const - { Extension flag bit masks } - efInputFlag = $02; { 00000010 } - efDisposal = $1C; { 00011100 } - efTransparent = $01; { 00000001 } - efReserved = $E0; { 11100000 } - -constructor TGIFGraphicControlExtension.Create(ASubImage: TGIFSubImage); -begin - inherited Create(ASubImage); - - FGCExtension.BlockSize := 4; - FGCExtension.PackedFields := $00; - FGCExtension.DelayTime := 0; - FGCExtension.TransparentColorIndex := 0; - FGCExtension.Terminator := 0; - if (ASubImage.FGCE = nil) then - ASubImage.FGCE := self; -end; - -destructor TGIFGraphicControlExtension.Destroy; -begin - // Clear transparent flag in sub image - if (Transparent) then - SubImage.FTransparent := False; - - if (SubImage.FGCE = self) then - SubImage.FGCE := nil; - - inherited Destroy; -end; - -function TGIFGraphicControlExtension.GetExtensionType: TGIFExtensionType; -begin - Result := bsGraphicControlExtension; -end; - -function TGIFGraphicControlExtension.GetTransparent: boolean; -begin - Result := (FGCExtension.PackedFields AND efTransparent) <> 0; -end; - -procedure TGIFGraphicControlExtension.SetTransparent(Value: boolean); -begin - // Set transparent flag in sub image - SubImage.FTransparent := Value; - if (Value) then - FGCExtension.PackedFields := FGCExtension.PackedFields OR efTransparent - else - FGCExtension.PackedFields := FGCExtension.PackedFields AND NOT(efTransparent); -end; - -function TGIFGraphicControlExtension.GetTransparentColor: TColor; -begin - Result := SubImage.ActiveColorMap[TransparentColorIndex]; -end; - -procedure TGIFGraphicControlExtension.SetTransparentColor(Color: TColor); -begin - FGCExtension.TransparentColorIndex := Subimage.ActiveColorMap.AddUnique(Color); -end; - -function TGIFGraphicControlExtension.GetTransparentColorIndex: BYTE; -begin - Result := FGCExtension.TransparentColorIndex; -end; - -procedure TGIFGraphicControlExtension.SetTransparentColorIndex(Value: BYTE); -begin - if ((Value >= SubImage.ActiveColorMap.Count) and (SubImage.ActiveColorMap.Count > 0)) then - begin - Warning(gsWarning, sBadColorIndex); - Value := 0; - end; - FGCExtension.TransparentColorIndex := Value; -end; - -function TGIFGraphicControlExtension.GetDelay: WORD; -begin - Result := FGCExtension.DelayTime; -end; -procedure TGIFGraphicControlExtension.SetDelay(Value: WORD); -begin - FGCExtension.DelayTime := Value; -end; - -function TGIFGraphicControlExtension.GetUserInput: boolean; -begin - Result := (FGCExtension.PackedFields AND efInputFlag) <> 0; -end; - -procedure TGIFGraphicControlExtension.SetUserInput(Value: boolean); -begin - if (Value) then - FGCExtension.PackedFields := FGCExtension.PackedFields OR efInputFlag - else - FGCExtension.PackedFields := FGCExtension.PackedFields AND NOT(efInputFlag); -end; - -function TGIFGraphicControlExtension.GetDisposal: TDisposalMethod; -begin - Result := TDisposalMethod((FGCExtension.PackedFields AND efDisposal) SHR 2); -end; - -procedure TGIFGraphicControlExtension.SetDisposal(Value: TDisposalMethod); -begin - FGCExtension.PackedFields := FGCExtension.PackedFields AND NOT(efDisposal) - OR ((ord(Value) SHL 2) AND efDisposal); -end; - -procedure TGIFGraphicControlExtension.SaveToStream(Stream: TStream); -begin - inherited SaveToStream(Stream); - Stream.Write(FGCExtension, sizeof(FGCExtension)); -end; - -procedure TGIFGraphicControlExtension.LoadFromStream(Stream: TStream); -begin - inherited LoadFromStream(Stream); - if (Stream.Read(FGCExtension, sizeof(FGCExtension)) <> sizeof(FGCExtension)) then - begin - Warning(gsWarning, sOutOfData); - exit; - end; - // Set transparent flag in sub image - if (Transparent) then - SubImage.FTransparent := True; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFTextExtension -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFTextExtension.Create(ASubImage: TGIFSubImage); -begin - inherited Create(ASubImage); - FText := TStringList.Create; - FPlainTextExtension.BlockSize := 12; - FPlainTextExtension.Left := 0; - FPlainTextExtension.Top := 0; - FPlainTextExtension.Width := 0; - FPlainTextExtension.Height := 0; - FPlainTextExtension.CellWidth := 0; - FPlainTextExtension.CellHeight := 0; - FPlainTextExtension.TextFGColorIndex := 0; - FPlainTextExtension.TextBGColorIndex := 0; -end; - -destructor TGIFTextExtension.Destroy; -begin - FText.Free; - inherited Destroy; -end; - -function TGIFTextExtension.GetExtensionType: TGIFExtensionType; -begin - Result := bsPlainTextExtension; -end; - -function TGIFTextExtension.GetForegroundColor: TColor; -begin - Result := SubImage.ColorMap[ForegroundColorIndex]; -end; - -procedure TGIFTextExtension.SetForegroundColor(Color: TColor); -begin - ForegroundColorIndex := SubImage.ActiveColorMap.AddUnique(Color); -end; - -function TGIFTextExtension.GetBackgroundColor: TColor; -begin - Result := SubImage.ActiveColorMap[BackgroundColorIndex]; -end; - -procedure TGIFTextExtension.SetBackgroundColor(Color: TColor); -begin - BackgroundColorIndex := SubImage.ColorMap.AddUnique(Color); -end; - -function TGIFTextExtension.GetBounds(Index: integer): WORD; -begin - case (Index) of - 1: Result := FPlainTextExtension.Left; - 2: Result := FPlainTextExtension.Top; - 3: Result := FPlainTextExtension.Width; - 4: Result := FPlainTextExtension.Height; - else - Result := 0; // To avoid compiler warnings - end; -end; - -procedure TGIFTextExtension.SetBounds(Index: integer; Value: WORD); -begin - case (Index) of - 1: FPlainTextExtension.Left := Value; - 2: FPlainTextExtension.Top := Value; - 3: FPlainTextExtension.Width := Value; - 4: FPlainTextExtension.Height := Value; - end; -end; - -function TGIFTextExtension.GetCharWidthHeight(Index: integer): BYTE; -begin - case (Index) of - 1: Result := FPlainTextExtension.CellWidth; - 2: Result := FPlainTextExtension.CellHeight; - else - Result := 0; // To avoid compiler warnings - end; -end; - -procedure TGIFTextExtension.SetCharWidthHeight(Index: integer; Value: BYTE); -begin - case (Index) of - 1: FPlainTextExtension.CellWidth := Value; - 2: FPlainTextExtension.CellHeight := Value; - end; -end; - -function TGIFTextExtension.GetColorIndex(Index: integer): BYTE; -begin - case (Index) of - 1: Result := FPlainTextExtension.TextFGColorIndex; - 2: Result := FPlainTextExtension.TextBGColorIndex; - else - Result := 0; // To avoid compiler warnings - end; -end; - -procedure TGIFTextExtension.SetColorIndex(Index: integer; Value: BYTE); -begin - case (Index) of - 1: FPlainTextExtension.TextFGColorIndex := Value; - 2: FPlainTextExtension.TextBGColorIndex := Value; - end; -end; - -procedure TGIFTextExtension.SaveToStream(Stream: TStream); -begin - inherited SaveToStream(Stream); - Stream.Write(FPlainTextExtension, sizeof(FPlainTextExtension)); - WriteStrings(Stream, FText); -end; - -procedure TGIFTextExtension.LoadFromStream(Stream: TStream); -begin - inherited LoadFromStream(Stream); - ReadCheck(Stream, FPlainTextExtension, sizeof(FPlainTextExtension)); - ReadStrings(Stream, FText); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFCommentExtension -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFCommentExtension.Create(ASubImage: TGIFSubImage); -begin - inherited Create(ASubImage); - FText := TStringList.Create; -end; - -destructor TGIFCommentExtension.Destroy; -begin - FText.Free; - inherited Destroy; -end; - -function TGIFCommentExtension.GetExtensionType: TGIFExtensionType; -begin - Result := bsCommentExtension; -end; - -procedure TGIFCommentExtension.SaveToStream(Stream: TStream); -begin - inherited SaveToStream(Stream); - WriteStrings(Stream, FText); -end; - -procedure TGIFCommentExtension.LoadFromStream(Stream: TStream); -begin - inherited LoadFromStream(Stream); - ReadStrings(Stream, FText); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFApplicationExtension registration database -// -//////////////////////////////////////////////////////////////////////////////// -type - PAppExtRec = ^TAppExtRec; - TAppExtRec = record - AppClass: TGIFAppExtensionClass; - Ident: TGIFApplicationRec; - end; - - TAppExtensionList = class(TList) - public - constructor Create; - destructor Destroy; override; - procedure Add(eIdent: TGIFApplicationRec; eClass: TGIFAppExtensionClass); - function FindExt(eIdent: TGIFApplicationRec): TGIFAppExtensionClass; - procedure Remove(eClass: TGIFAppExtensionClass); - end; - -constructor TAppExtensionList.Create; -const - NSLoopIdent: array[0..1] of TGIFApplicationRec = - ((Identifier: 'NETSCAPE'; Authentication: '2.0'), - (Identifier: 'ANIMEXTS'; Authentication: '1.0')); -begin - inherited Create; - Add(NSLoopIdent[0], TGIFAppExtNSLoop); - Add(NSLoopIdent[1], TGIFAppExtNSLoop); -end; - -destructor TAppExtensionList.Destroy; -var - I: Integer; -begin - for I := 0 to Count-1 do - Dispose(PAppExtRec(Items[I])); - inherited Destroy; -end; - -procedure TAppExtensionList.Add(eIdent: TGIFApplicationRec; eClass: TGIFAppExtensionClass); -var - NewRec: PAppExtRec; -begin - New(NewRec); - NewRec^.Ident := eIdent; - NewRec^.AppClass := eClass; - inherited Add(NewRec); -end; - -function TAppExtensionList.FindExt(eIdent: TGIFApplicationRec): TGIFAppExtensionClass; -var - I: Integer; -begin - for I := Count-1 downto 0 do - with PAppExtRec(Items[I])^ do - if CompareMem(@Ident, @eIdent, sizeof(TGIFApplicationRec)) then - begin - Result := AppClass; - Exit; - end; - Result := nil; -end; - -procedure TAppExtensionList.Remove(eClass: TGIFAppExtensionClass); -var - I: Integer; - P: PAppExtRec; -begin - for I := Count-1 downto 0 do - begin - P := PAppExtRec(Items[I]); - if P^.AppClass.InheritsFrom(eClass) then - begin - Dispose(P); - Delete(I); - end; - end; -end; - -var - AppExtensionList: TAppExtensionList = nil; - -function GetAppExtensionList: TAppExtensionList; -begin - if (AppExtensionList = nil) then - AppExtensionList := TAppExtensionList.Create; - Result := AppExtensionList; -end; - -class procedure TGIFApplicationExtension.RegisterExtension(eIdent: TGIFApplicationRec; - eClass: TGIFAppExtensionClass); -begin - GetAppExtensionList.Add(eIdent, eClass); -end; - -class function TGIFApplicationExtension.FindSubExtension(Stream: TStream): TGIFExtensionClass; -var - eIdent : TGIFApplicationRec; - OldPos : longInt; - Size : BYTE; -begin - OldPos := Stream.Position; - Result := nil; - if (Stream.Read(Size, 1) <> 1) then - exit; - - // Some old Adobe export filters mistakenly uses a value of 10 - if (Size = 10) then - begin - {.TODO -oanme -cImprovement : replace with seek or read and check contents = 'Adobe' } - if (Stream.Read(eIdent, 10) <> 10) then - exit; - Result := TGIFUnknownAppExtension; - exit; - end else - if (Size <> sizeof(TGIFApplicationRec)) or - (Stream.Read(eIdent, sizeof(eIdent)) <> sizeof(eIdent)) then - begin - Stream.Position := OldPos; - Result := inherited FindSubExtension(Stream); - end else - begin - Result := GetAppExtensionList.FindExt(eIdent); - if (Result = nil) then - Result := TGIFUnknownAppExtension; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFApplicationExtension -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFApplicationExtension.Create(ASubImage: TGIFSubImage); -begin - inherited Create(ASubImage); - FillChar(FIdent, sizeof(FIdent), 0); -end; - -destructor TGIFApplicationExtension.Destroy; -begin - inherited Destroy; -end; - -function TGIFApplicationExtension.GetExtensionType: TGIFExtensionType; -begin - Result := bsApplicationExtension; -end; - -function TGIFApplicationExtension.GetAuthentication: AnsiString; -begin - Result := FIdent.Authentication; -end; - -procedure TGIFApplicationExtension.SetAuthentication(const Value: AnsiString); -begin - if (Length(Value) < sizeof(TGIFAuthenticationCode)) then - FillChar(FIdent.Authentication, sizeof(TGIFAuthenticationCode), 32); - StrLCopy(@(FIdent.Authentication[0]), PAnsiChar(Value), sizeof(TGIFAuthenticationCode)); -end; - -function TGIFApplicationExtension.GetIdentifier: AnsiString; -begin - Result := FIdent.Identifier; -end; - -procedure TGIFApplicationExtension.SetIdentifier(const Value: AnsiString); -begin - if (Length(Value) < sizeof(TGIFIdentifierCode)) then - FillChar(FIdent.Identifier, sizeof(TGIFIdentifierCode), 32); - StrLCopy(@(FIdent.Identifier[0]), PAnsiChar(Value), sizeof(TGIFIdentifierCode)); -end; - -procedure TGIFApplicationExtension.SaveToStream(Stream: TStream); -begin - inherited SaveToStream(Stream); - WriteByte(Stream, sizeof(FIdent)); // Block size - Stream.Write(FIdent, sizeof(FIdent)); - SaveData(Stream); -end; - -procedure TGIFApplicationExtension.LoadFromStream(Stream: TStream); -var - i : integer; -begin - inherited LoadFromStream(Stream); - i := ReadByte(Stream); - // Some old Adobe export filters mistakenly uses a value of 10 - if (i = 10) then - FillChar(FIdent, sizeOf(FIdent), 0) - else - if (i < 11) then - Error(sBadBlockSize); - - ReadCheck(Stream, FIdent, sizeof(FIdent)); - - Dec(i, sizeof(FIdent)); - // Ignore extra data - Stream.Seek(i, soFromCurrent); - - // ***FIXME*** - // If self class is TGIFApplicationExtension, this will cause an "abstract - // error". - // TGIFApplicationExtension.LoadData should read and ignore rest of block. - LoadData(Stream); -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFUnknownAppExtension -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFBlock.Create(ASize: integer); -begin - inherited Create; - FSize := ASize; - GetMem(FData, FSize); - FillChar(FData^, FSize, 0); -end; - -destructor TGIFBlock.Destroy; -begin - FreeMem(FData); - inherited Destroy; -end; - -procedure TGIFBlock.SaveToStream(Stream: TStream); -begin - Stream.Write(FSize, 1); - Stream.Write(FData^, FSize); -end; - -procedure TGIFBlock.LoadFromStream(Stream: TStream); -begin - ReadCheck(Stream, FData^, FSize); -end; - -constructor TGIFUnknownAppExtension.Create(ASubImage: TGIFSubImage); -begin - inherited Create(ASubImage); - FBlocks := TList.Create; -end; - -destructor TGIFUnknownAppExtension.Destroy; -var - i : integer; -begin - for i := 0 to FBlocks.Count-1 do - TGIFBlock(FBlocks[i]).Free; - FBlocks.Free; - inherited Destroy; -end; - - -procedure TGIFUnknownAppExtension.SaveData(Stream: TStream); -var - i : integer; -begin - for i := 0 to FBlocks.Count-1 do - TGIFBlock(FBlocks[i]).SaveToStream(Stream); - // Terminating zero - WriteByte(Stream, 0); -end; - -procedure TGIFUnknownAppExtension.LoadData(Stream: TStream); -var - b : BYTE; - Block : TGIFBlock; - i : integer; -begin - // Zap old blocks - for i := 0 to FBlocks.Count-1 do - TGIFBlock(FBlocks[i]).Free; - FBlocks.Clear; - - // Read blocks - if (Stream.Read(b, 1) <> 1) then - exit; - while (b <> 0) do - begin - Block := TGIFBlock.Create(b); - try - Block.LoadFromStream(Stream); - except - Block.Free; - raise; - end; - FBlocks.Add(Block); - if (Stream.Read(b, 1) <> 1) then - exit; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFAppExtNSLoop -// -//////////////////////////////////////////////////////////////////////////////// -const - // Netscape sub block types - nbLoopExtension = 1; - nbBufferExtension = 2; - -constructor TGIFAppExtNSLoop.Create(ASubImage: TGIFSubImage); -const - NSLoopIdent: TGIFApplicationRec = (Identifier: 'NETSCAPE'; Authentication: '2.0'); -begin - inherited Create(ASubImage); - FIdent := NSLoopIdent; -end; - -procedure TGIFAppExtNSLoop.SaveData(Stream: TStream); -begin - // Write loop count - WriteByte(Stream, 1 + sizeof(FLoops)); // Size of block - WriteByte(Stream, nbLoopExtension); // Identify sub block as looping extension data - Stream.Write(FLoops, sizeof(FLoops)); // Loop count - - // Write buffer size if specified - if (FBufferSize > 0) then - begin - WriteByte(Stream, 1 + sizeof(FBufferSize)); // Size of block - WriteByte(Stream, nbBufferExtension); // Identify sub block as buffer size data - Stream.Write(FBufferSize, sizeof(FBufferSize)); // Buffer size - end; - - WriteByte(Stream, 0); // Terminating zero -end; - -procedure TGIFAppExtNSLoop.LoadData(Stream: TStream); -var - BlockSize : integer; - BlockType : integer; -begin - // Read size of first block or terminating zero - BlockSize := ReadByte(Stream); - while (BlockSize <> 0) do - begin - BlockType := ReadByte(Stream); - dec(BlockSize); - - case (BlockType AND $07) of - nbLoopExtension: - begin - if (BlockSize < sizeof(FLoops)) then - Error(sInvalidData); - // Read loop count - ReadCheck(Stream, FLoops, sizeof(FLoops)); - dec(BlockSize, sizeof(FLoops)); - end; - nbBufferExtension: - begin - if (BlockSize < sizeof(FBufferSize)) then - Error(sInvalidData); - // Read buffer size - ReadCheck(Stream, FBufferSize, sizeof(FBufferSize)); - dec(BlockSize, sizeof(FBufferSize)); - end; - end; - - // Skip/ignore unread data - if (BlockSize > 0) then - Stream.Seek(BlockSize, soFromCurrent); - - // Read size of next block or terminating zero - BlockSize := ReadByte(Stream); - end; -end; - - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFImageList -// -//////////////////////////////////////////////////////////////////////////////// -function TGIFImageList.GetImage(Index: Integer): TGIFSubImage; -begin - Result := TGIFSubImage(Items[Index]); -end; - -procedure TGIFImageList.SetImage(Index: Integer; SubImage: TGIFSubImage); -begin - Items[Index] := SubImage; -end; - -procedure TGIFImageList.LoadFromStream(Stream: TStream; Parent: TObject); -var - b : BYTE; - SubImage : TGIFSubImage; -begin - // Peek ahead to determine block type - repeat - if (Stream.Read(b, 1) <> 1) then - exit; - until (b <> 0); // Ignore 0 padding (non-compliant) - - while (b <> bsTrailer) do - begin - Stream.Seek(-1, soFromCurrent); - if (b in [bsExtensionIntroducer, bsImageDescriptor]) then - begin - SubImage := TGIFSubImage.Create(Parent as TGIFImage); - try - SubImage.LoadFromStream(Stream); - Add(SubImage); - Image.Progress(Self, psRunning, MulDiv(Stream.Position, 100, Stream.Size), - GIFImageRenderOnLoad, Rect(0,0,0,0), sProgressLoading); - except - SubImage.Free; - raise; - end; - end else - begin - Warning(gsWarning, sBadBlock); - break; - end; - repeat - if (Stream.Read(b, 1) <> 1) then - exit; - until (b <> 0); // Ignore 0 padding (non-compliant) - end; - Stream.Seek(-1, soFromCurrent); -end; - -procedure TGIFImageList.SaveToStream(Stream: TStream); -var - i : integer; -begin - for i := 0 to Count-1 do - begin - TGIFItem(Items[i]).SaveToStream(Stream); - Image.Progress(Self, psRunning, MulDiv((i+1), 100, Count), False, Rect(0,0,0,0), sProgressSaving); - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFPainter -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFPainter.CreateRef(Painter: PGIFPainter; AImage: TGIFImage; - ACanvas: TCanvas; ARect: TRect; Options: TGIFDrawOptions); -begin - Create(AImage, ACanvas, ARect, Options); - PainterRef := Painter; - if (PainterRef <> nil) then - PainterRef^ := self; -end; - -constructor TGIFPainter.Create(AImage: TGIFImage; ACanvas: TCanvas; ARect: TRect; - Options: TGIFDrawOptions); -var - i : integer; - BackgroundColor : TColor; - Disposals : set of TDisposalMethod; -begin - inherited Create(True); - FreeOnTerminate := True; - Onterminate := DoOnTerminate; - FImage := AImage; - FCanvas := ACanvas; - FRect := ARect; - FActiveImage := -1; - FDrawOptions := Options; - FStarted := False; - BackupBuffer := nil; - FrameBuffer := nil; - Background := nil; - FEventHandle := 0; - // This should be a parameter, but I think I've got enough of them already... - FAnimationSpeed := FImage.AnimationSpeed; - - // An event handle is used for animation delays - if (FDrawOptions >= [goAnimate, goAsync]) and (FImage.Images.Count > 1) and - (FAnimationSpeed >= 0) then - FEventHandle := CreateEvent(nil, False, False, nil); - - // Preprocessing of extensions to determine if we need frame buffers - Disposals := []; - if (FImage.DrawBackgroundColor = clNone) then - begin - if (FImage.GlobalColorMap.Count > 0) then - BackgroundColor := FImage.BackgroundColor - else - BackgroundColor := ColorToRGB(clWindow); - end else - BackgroundColor := ColorToRGB(FImage.DrawBackgroundColor); - - // Need background buffer to clear on loop - if (goClearOnLoop in FDrawOptions) then - Include(Disposals, dmBackground); - - for i := 0 to FImage.Images.Count-1 do - if (FImage.Images[i].GraphicControlExtension <> nil) then - with (FImage.Images[i].GraphicControlExtension) do - Include(Disposals, Disposal); - - // Need background buffer to draw transparent on background - if (dmBackground in Disposals) and (goTransparent in FDrawOptions) then - begin - Background := TBitmap.Create; - Background.Height := FRect.Bottom-FRect.Top; - Background.Width := FRect.Right-FRect.Left; - // Copy background immediately - Background.Canvas.CopyMode := cmSrcCopy; - Background.Canvas.CopyRect(Background.Canvas.ClipRect, FCanvas, FRect); - end; - // Need frame- and backup buffer to restore to previous and background - if ((Disposals * [dmPrevious, dmBackground]) <> []) then - begin - BackupBuffer := TBitmap.Create; - BackupBuffer.Height := FRect.Bottom-FRect.Top; - BackupBuffer.Width := FRect.Right-FRect.Left; - BackupBuffer.Canvas.CopyMode := cmSrcCopy; - BackupBuffer.Canvas.Brush.Color := BackgroundColor; - BackupBuffer.Canvas.Brush.Style := bsSolid; -{$IFDEF DEBUG} - BackupBuffer.Canvas.Brush.Color := clBlack; - BackupBuffer.Canvas.Brush.Style := bsDiagCross; -{$ENDIF} - // Step 1: Copy destination to backup buffer - // Always executed before first frame and only once. - BackupBuffer.Canvas.CopyRect(BackupBuffer.Canvas.ClipRect, FCanvas, FRect); - FrameBuffer := TBitmap.Create; - FrameBuffer.Height := FRect.Bottom-FRect.Top; - FrameBuffer.Width := FRect.Right-FRect.Left; - FrameBuffer.Canvas.CopyMode := cmSrcCopy; - FrameBuffer.Canvas.Brush.Color := BackgroundColor; - FrameBuffer.Canvas.Brush.Style := bsSolid; -{$IFDEF DEBUG} - FrameBuffer.Canvas.Brush.Color := clBlack; - FrameBuffer.Canvas.Brush.Style := bsDiagCross; -{$ENDIF} - end; -end; - -destructor TGIFPainter.Destroy; -begin - // OnTerminate isn't called if we are running in main thread, so we must call - // it manually - if not(goAsync in DrawOptions) then - DoOnTerminate(self); - // Reraise any exptions that were eaten in the Execute method - if (ExceptObject <> nil) then - raise ExceptObject at ExceptAddress; - inherited Destroy; -end; - -procedure TGIFPainter.SetAnimationSpeed(Value: integer); -begin - if (Value < 0) then - Value := 0 - else if (Value > 1000) then - Value := 1000; - if (Value <> FAnimationSpeed) then - begin - FAnimationSpeed := Value; - // Signal WaitForSingleObject delay to abort - if (FEventHandle <> 0) then - SetEvent(FEventHandle) - else - DoRestart := True; - end; -end; - -procedure TGIFPainter.SetActiveImage(const Value: integer); -begin - if (Value >= 0) and (Value < FImage.Images.Count) then - FActiveImage := Value; -end; - -// Conditional Synchronize -procedure TGIFPainter.DoSynchronize(Method: TThreadMethod); -begin - if (Terminated) then - exit; - if (goAsync in FDrawOptions) then - // Execute Synchronized if requested... - Synchronize(Method) - else - // ...Otherwise just execute in current thread (probably main thread) - Method; -end; - -// Delete frame buffers - Executed in main thread -procedure TGIFPainter.DoOnTerminate(Sender: TObject); -begin - // It shouldn't really be nescessary to protect PainterRef in this manner - // since we are running in the main thread at this point, but I'm a little - // paranoid about the way PainterRef is being used... - if Image <> nil then // 2001.02.23 - begin // 2001.02.23 - with Image.Painters.LockList do - try - // Zap pointer to self and remove from painter list - if (PainterRef <> nil) and (PainterRef^ = self) then - PainterRef^ := nil; - finally - Image.Painters.UnLockList; - end; - Image.Painters.Remove(self); - FImage := nil; - end; // 2001.02.23 - - // Free buffers - if (BackupBuffer <> nil) then - BackupBuffer.Free; - if (FrameBuffer <> nil) then - FrameBuffer.Free; - if (Background <> nil) then - Background.Free; - - // Delete event handle - if (FEventHandle <> 0) then - CloseHandle(FEventHandle); -end; - -// Event "dispatcher" - Executed in main thread -procedure TGIFPainter.DoEvent; -begin - if (Assigned(FEvent)) then - FEvent(self); -end; - -// Non-buffered paint - Executed in main thread -procedure TGIFPainter.DoPaint; -begin - FImage.Images[ActiveImage].Draw(FCanvas, FRect, (goTransparent in FDrawOptions), - (goTile in FDrawOptions)); - FStarted := True; -end; - -// Buffered paint - Executed in main thread -procedure TGIFPainter.DoPaintFrame; -var - DrawDestination : TCanvas; - DrawRect : TRect; - DoStep2 , - DoStep3 , - DoStep5 , - DoStep6 : boolean; - SavePal , - SourcePal : HPALETTE; - - procedure ClearBackup; - var - r , - Tile : TRect; - FrameTop , - FrameHeight : integer; - ImageWidth , - ImageHeight : integer; - begin - - if (goTransparent in FDrawOptions) then - begin - // If the frame is transparent, we must remove it by copying the - // background buffer over it - if (goTile in FDrawOptions) then - begin - FrameTop := FImage.Images[ActiveImage].Top; - FrameHeight := FImage.Images[ActiveImage].Height; - ImageWidth := FImage.Width; - ImageHeight := FImage.Height; - - Tile.Left := FRect.Left + FImage.Images[ActiveImage].Left; - Tile.Right := Tile.Left + FImage.Images[ActiveImage].Width; - while (Tile.Left < FRect.Right) do - begin - Tile.Top := FRect.Top + FrameTop; - Tile.Bottom := Tile.Top + FrameHeight; - while (Tile.Top < FRect.Bottom) do - begin - BackupBuffer.Canvas.CopyRect(Tile, Background.Canvas, Tile); - Tile.Top := Tile.Top + ImageHeight; - Tile.Bottom := Tile.Bottom + ImageHeight; - end; - Tile.Left := Tile.Left + ImageWidth; - Tile.Right := Tile.Right + ImageWidth; - end; - end else - begin - r := FImage.Images[ActiveImage].ScaleRect(BackupBuffer.Canvas.ClipRect); - BackupBuffer.Canvas.CopyRect(r, Background.Canvas, r) - end; - end else - begin - // If the frame isn't transparent, we just clear the area covered by - // it to the background color. - // Tile the background unless the frame covers all of the image - if (goTile in FDrawOptions) and - ((FImage.Width <> FImage.Images[ActiveImage].Width) and - (FImage.height <> FImage.Images[ActiveImage].Height)) then - begin - FrameTop := FImage.Images[ActiveImage].Top; - FrameHeight := FImage.Images[ActiveImage].Height; - ImageWidth := FImage.Width; - ImageHeight := FImage.Height; - // ***FIXME*** I don't think this does any difference - BackupBuffer.Canvas.Brush.Color := FImage.DrawBackgroundColor; - - Tile.Left := FRect.Left + FImage.Images[ActiveImage].Left; - Tile.Right := Tile.Left + FImage.Images[ActiveImage].Width; - while (Tile.Left < FRect.Right) do - begin - Tile.Top := FRect.Top + FrameTop; - Tile.Bottom := Tile.Top + FrameHeight; - while (Tile.Top < FRect.Bottom) do - begin - BackupBuffer.Canvas.FillRect(Tile); - - Tile.Top := Tile.Top + ImageHeight; - Tile.Bottom := Tile.Bottom + ImageHeight; - end; - Tile.Left := Tile.Left + ImageWidth; - Tile.Right := Tile.Right + ImageWidth; - end; - end else - BackupBuffer.Canvas.FillRect(FImage.Images[ActiveImage].ScaleRect(FRect)); - end; - end; - -begin - if (goValidateCanvas in FDrawOptions) then - if (GetObjectType(ValidateDC) <> OBJ_DC) then - begin - Terminate; - exit; - end; - - DrawDestination := nil; - DoStep2 := (goClearOnLoop in FDrawOptions) and (FActiveImage = 0); - DoStep3 := False; - DoStep5 := False; - DoStep6 := False; -{ -Disposal mode algorithm: - -Step 1: Copy destination to backup buffer - Always executed before first frame and only once. - Done in constructor. -Step 2: Clear previous frame (implementation is same as step 6) - Done implicitly by implementation. - Only done explicitly on first frame if goClearOnLoop option is set. -Step 3: Copy backup buffer to frame buffer -Step 4: Draw frame -Step 5: Copy buffer to destination -Step 6: Clear frame from backup buffer -+------------+------------------+---------------------+------------------------+ -|New \ Old | dmNone | dmBackground | dmPrevious | -+------------+------------------+---------------------+------------------------+ -|dmNone | | | | -| |4. Paint on backup|4. Paint on backup |4. Paint on backup | -| |5. Restore |5. Restore |5. Restore | -+------------+------------------+---------------------+------------------------+ -|dmBackground| | | | -| |4. Paint on backup|4. Paint on backup |4. Paint on backup | -| |5. Restore |5. Restore |5. Restore | -| |6. Clear backup |6. Clear backup |6. Clear backup | -+------------+------------------+---------------------+------------------------+ -|dmPrevious | | | | -| | |3. Copy backup to buf|3. Copy backup to buf | -| |4. Paint on dest |4. Paint on buf |4. Paint on buf | -| | |5. Copy buf to dest |5. Copy buf to dest | -+------------+------------------+---------------------+------------------------+ -} - case (Disposal) of - dmNone, dmNoDisposal: - begin - DrawDestination := BackupBuffer.Canvas; - DrawRect := BackupBuffer.Canvas.ClipRect; - DoStep5 := True; - end; - dmBackground: - begin - DrawDestination := BackupBuffer.Canvas; - DrawRect := BackupBuffer.Canvas.ClipRect; - DoStep5 := True; - DoStep6 := True; - end; - dmPrevious: - case (OldDisposal) of - dmNone, dmNoDisposal: - begin - DrawDestination := FCanvas; - DrawRect := FRect; - end; - dmBackground, dmPrevious: - begin - DrawDestination := FrameBuffer.Canvas; - DrawRect := FrameBuffer.Canvas.ClipRect; - DoStep3 := True; - DoStep5 := True; - end; - end; - end; - - // Find source palette - SourcePal := FImage.Images[ActiveImage].Palette; - if (SourcePal = 0) then - SourcePal := SystemPalette16; // This should never happen - - SavePal := SelectPalette(DrawDestination.Handle, SourcePal, False); - RealizePalette(DrawDestination.Handle); - - // Step 2: Clear previous frame - if (DoStep2) then - ClearBackup; - - // Step 3: Copy backup buffer to frame buffer - if (DoStep3) then - FrameBuffer.Canvas.CopyRect(FrameBuffer.Canvas.ClipRect, - BackupBuffer.Canvas, BackupBuffer.Canvas.ClipRect); - - // Step 4: Draw frame - if (DrawDestination <> nil) then - FImage.Images[ActiveImage].Draw(DrawDestination, DrawRect, - (goTransparent in FDrawOptions), (goTile in FDrawOptions)); - - // Step 5: Copy buffer to destination - if (DoStep5) then - begin - FCanvas.CopyMode := cmSrcCopy; - FCanvas.CopyRect(FRect, DrawDestination, DrawRect); - end; - - if (SavePal <> 0) then - SelectPalette(DrawDestination.Handle, SavePal, False); - - // Step 6: Clear frame from backup buffer - if (DoStep6) then - ClearBackup; - - FStarted := True; -end; - -// Prefetch bitmap -// Used to force the GIF image to be rendered as a bitmap -{$ifdef SERIALIZE_RENDER} -procedure TGIFPainter.PrefetchBitmap; -begin - // Touch current bitmap to force bitmap to be rendered - if not((FImage.Images[ActiveImage].Empty) or (FImage.Images[ActiveImage].HasBitmap)) then - FImage.Images[ActiveImage].Bitmap; -end; -{$endif} - -// Main thread execution loop - This is where it all happens... -procedure TGIFPainter.Execute; -var - i : integer; - LoopCount , - LoopPoint : integer; - Looping : boolean; - Ext : TGIFExtension; - Msg : TMsg; - Delay , - OldDelay , - DelayUsed : longInt; - DelayStart , - NewDelayStart : DWORD; - - procedure FireEvent(Event: TNotifyEvent); - begin - if not(Assigned(Event)) then - exit; - FEvent := Event; - try - DoSynchronize(DoEvent); - finally - FEvent := nil; - end; - end; - -begin -{ - Disposal: - dmNone: Same as dmNodisposal - dmNoDisposal: Do not dispose - dmBackground: Clear with background color *) - dmPrevious: Previous image - *) Note: Background color should either be a BROWSER SPECIFIED Background - color (DrawBackgroundColor) or the background image if any frames are - transparent. -} - try - try - if (goValidateCanvas in FDrawOptions) then - ValidateDC := FCanvas.Handle; - DoRestart := True; - - // Loop to restart paint - while (DoRestart) and not(Terminated) do - begin - FActiveImage := 0; - // Fire OnStartPaint event - // Note: ActiveImage may be altered by the event handler - FireEvent(FOnStartPaint); - - FStarted := False; - DoRestart := False; - LoopCount := 1; - LoopPoint := FActiveImage; - Looping := False; - if (goAsync in DrawOptions) then - Delay := 0 - else - Delay := 1; // Dummy to process messages - OldDisposal := dmNoDisposal; - // Fetch delay start time - DelayStart := timeGetTime; - OldDelay := 0; - - // Loop to loop - duh! - while ((LoopCount <> 0) or (goLoopContinously in DrawOptions)) and - not(Terminated or DoRestart) do - begin - FActiveImage := LoopPoint; - - // Fire OnLoopPaint event - // Note: ActiveImage may be altered by the event handler - if (FStarted) then - FireEvent(FOnLoop); - - // Loop to animate - while (ActiveImage < FImage.Images.Count) and not(Terminated or DoRestart) do - begin - // Ignore empty images - if (FImage.Images[ActiveImage].Empty) then - break; - // Delay from previous image - if (Delay > 0) then - begin - // Prefetch frame bitmap -{$ifdef SERIALIZE_RENDER} - DoSynchronize(PrefetchBitmap); -{$else} - FImage.Images[ActiveImage].Bitmap; -{$endif} - - // Calculate inter frame delay - NewDelayStart := timeGetTime; - if (FAnimationSpeed > 0) then - begin - // Calculate number of mS used in prefetch and display - try - DelayUsed := integer(NewDelayStart-DelayStart)-OldDelay; - // Prevent feedback oscillations caused by over/undercompensation. - DelayUsed := DelayUsed DIV 2; - // Convert delay value to mS and... - // ...Adjust for time already spent converting GIF to bitmap and... - // ...Adjust for Animation Speed factor. - Delay := MulDiv(Delay * GIFDelayExp - DelayUsed, 100, FAnimationSpeed); - OldDelay := Delay; - except - Delay := GIFMaximumDelay * GIFDelayExp; - OldDelay := 0; - end; - end else - begin - if (goAsync in DrawOptions) then - Delay := longInt(INFINITE) - else - Delay := GIFMaximumDelay * GIFDelayExp; - end; - // Fetch delay start time - DelayStart := NewDelayStart; - - // Sleep in one chunk if we are running in a thread - if (goAsync in DrawOptions) then - begin - // Use of WaitForSingleObject allows TGIFPainter.Stop to wake us up - if (Delay > 0) or (FAnimationSpeed = 0) then - begin - if (WaitForSingleObject(FEventHandle, DWORD(Delay)) <> WAIT_TIMEOUT) then - begin - // Don't use interframe delay feedback adjustment if delay - // were prematurely aborted (e.g. because the animation - // speed were changed) - OldDelay := 0; - DelayStart := longInt(timeGetTime); - end; - end; - end else - begin - if (Delay <= 0) then - Delay := 1; - // Fetch start time - NewDelayStart := timeGetTime; - // If we are not running in a thread we Sleep in small chunks - // and give the user a chance to abort - while (Delay > 0) and not(Terminated or DoRestart) do - begin - if (Delay < 100) then - Sleep(Delay) - else - Sleep(100); - // Calculate number of mS delayed in this chunk - DelayUsed := integer(timeGetTime - NewDelayStart); - dec(Delay, DelayUsed); - // Reset start time for chunk - NewDelaySTart := timeGetTime; - // Application.ProcessMessages wannabe - while (not(Terminated or DoRestart)) and - (PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) do - begin - if (Msg.Message <> WM_QUIT) then - begin - TranslateMessage(Msg); - DispatchMessage(Msg); - end else - begin - // Put WM_QUIT back in queue and get out of here fast - PostQuitMessage(Msg.WParam); - Terminate; - end; - end; - end; - end; - end else - Sleep(0); // Yield - if (Terminated) then - break; - - // Fire OnPaint event - // Note: ActiveImage may be altered by the event handler - FireEvent(FOnPaint); - if (Terminated) then - break; - - // Pre-draw processing of extensions - Disposal := dmNoDisposal; - for i := 0 to FImage.Images[ActiveImage].Extensions.Count-1 do - begin - Ext := FImage.Images[ActiveImage].Extensions[i]; - if (Ext is TGIFAppExtNSLoop) then - begin - // Recursive loops not supported (or defined) - if (Looping) then - continue; - Looping := True; - LoopCount := TGIFAppExtNSLoop(Ext).Loops; - if ((LoopCount = 0) or (goLoopContinously in DrawOptions)) and - (goAsync in DrawOptions) then - LoopCount := -1; // Infinite if running in separate thread -{$IFNDEF STRICT_MOZILLA} - // Loop from this image and on - // Note: This is not standard behavior - LoopPoint := ActiveImage; -{$ENDIF} - end else - if (Ext is TGIFGraphicControlExtension) then - Disposal := TGIFGraphicControlExtension(Ext).Disposal; - end; - - // Paint the image - if (BackupBuffer <> nil) then - DoSynchronize(DoPaintFrame) - else - DoSynchronize(DoPaint); - OldDisposal := Disposal; - - if (Terminated) then - break; - - Delay := GIFDefaultDelay; // Default delay - // Post-draw processing of extensions - if (FImage.Images[ActiveImage].GraphicControlExtension <> nil) then - if (FImage.Images[ActiveImage].GraphicControlExtension.Delay > 0) then - begin - Delay := FImage.Images[ActiveImage].GraphicControlExtension.Delay; - - // Enforce minimum animation delay in compliance with Mozilla - if (Delay < GIFMinimumDelay) then - Delay := GIFMinimumDelay; - - // Do not delay more than 10 seconds if running in main thread - if (Delay > GIFMaximumDelay) and not(goAsync in DrawOptions) then - Delay := GIFMaximumDelay; // Max 10 seconds - end; - // Fire OnAfterPaint event - // Note: ActiveImage may be altered by the event handler - i := FActiveImage; - FireEvent(FOnAfterPaint); - if (Terminated) then - break; - // Don't increment frame counter if event handler modified - // current frame - if (FActiveImage = i) then - Inc(FActiveImage); - // Nothing more to do unless we are animating - if not(goAnimate in DrawOptions) then - break; - end; - - if (LoopCount > 0) then - Dec(LoopCount); - if ([goAnimate, goLoop] * DrawOptions <> [goAnimate, goLoop]) then - break; - end; - if (Terminated) then // 2001.07.23 - break; // 2001.07.23 - end; - FActiveImage := -1; - // Fire OnEndPaint event - FireEvent(FOnEndPaint); - finally - // If we are running in the main thread we will have to zap our self - if not(goAsync in DrawOptions) then - Free; - end; - except - on E: Exception do - begin - // Eat exception and terminate thread... - // If we allow the exception to abort the thread at this point, the - // application will hang since the thread destructor will never be called - // and the application will wait forever for the thread to die! - Terminate; - // Clone exception - ExceptObject := E.Create(E.Message); - ExceptAddress := ExceptAddr; - end; - end; -end; - -procedure TGIFPainter.Start; -begin - if (goAsync in FDrawOptions) then - Resume; -end; - -procedure TGIFPainter.Stop; -begin - Terminate; - if (goAsync in FDrawOptions) then - begin - // Signal WaitForSingleObject delay to abort - if (FEventHandle <> 0) then - SetEvent(FEventHandle); - Priority := tpNormal; - if (Suspended) then - Resume; // Must be running before we can terminate - end; -end; - -procedure TGIFPainter.Restart; -begin - DoRestart := True; - if (Suspended) and (goAsync in FDrawOptions) then - Resume; // Must be running before we can terminate -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TColorMapOptimizer -// -//////////////////////////////////////////////////////////////////////////////// -// Used by TGIFImage to optimize local color maps to a single global color map. -// The following algorithm is used: -// 1) Build a histogram for each image -// 2) Merge histograms -// 3) Sum equal colors and adjust max # of colors -// 4) Map entries > max to entries <= 256 -// 5) Build new color map -// 6) Map images to new color map -//////////////////////////////////////////////////////////////////////////////// - -type - - POptimizeEntry = ^TOptimizeEntry; - TColorRec = record - case byte of - 0: (Value: integer); - 1: (Color: TGIFColor); - 2: (SameAs: POptimizeEntry); // Used if TOptimizeEntry.Count = 0 - end; - - TOptimizeEntry = record - Count : integer; // Usage count - OldIndex : integer; // Color OldIndex - NewIndex : integer; // NewIndex color OldIndex - Color : TColorRec; // Color value - end; - - TOptimizeEntries = array[0..255] of TOptimizeEntry; - POptimizeEntries = ^TOptimizeEntries; - - THistogram = class(TObject) - private - PHistogram : POptimizeEntries; - FCount : integer; - FColorMap : TGIFColorMap; - FList : TList; - FImages : TList; - public - constructor Create(AColorMap: TGIFColorMap); - destructor Destroy; override; - function ProcessSubImage(Image: TGIFSubImage): boolean; - function Prune: integer; - procedure MapImages(UseTransparency: boolean; NewTransparentColorIndex: byte); - property Count: integer read FCount; - property ColorMap: TGIFColorMap read FColorMap; - property List: TList read FList; - end; - - TColorMapOptimizer = class(TObject) - private - FImage : TGIFImage; - FHistogramList : TList; - FHistogram : TList; - FColorMap : TColorMap; - FFinalCount : integer; - FUseTransparency : boolean; - FNewTransparentColorIndex: byte; - protected - procedure ProcessImage; - procedure MergeColors; - procedure MapColors; - procedure ReplaceColorMaps; - public - constructor Create(AImage: TGIFImage); - destructor Destroy; override; - procedure Optimize; - end; - -function CompareColor(Item1, Item2: Pointer): integer; -begin - Result := POptimizeEntry(Item2)^.Color.Value - POptimizeEntry(Item1)^.Color.Value; -end; - -function CompareCount(Item1, Item2: Pointer): integer; -begin - Result := POptimizeEntry(Item2)^.Count - POptimizeEntry(Item1)^.Count; -end; - -constructor THistogram.Create(AColorMap: TGIFColorMap); -var - i : integer; -begin - inherited Create; - - FCount := AColorMap.Count; - FColorMap := AColorMap; - - FImages := TList.Create; - - // Allocate memory for histogram - GetMem(PHistogram, FCount * sizeof(TOptimizeEntry)); - FList := TList.Create; - - FList.Capacity := FCount; - - // Move data to histogram and initialize - for i := 0 to FCount-1 do - with PHistogram^[i] do - begin - FList.Add(@PHistogram^[i]); - OldIndex := i; - Count := 0; - Color.Value := 0; - Color.Color := AColorMap.Data^[i]; - NewIndex := 256; // Used to signal unmapped - end; -end; - -destructor THistogram.Destroy; -begin - FImages.Free; - FList.Free; - FreeMem(PHistogram); - inherited Destroy; -end; - -//: Build a color histogram -function THistogram.ProcessSubImage(Image: TGIFSubImage): boolean; -var - Size : integer; - Pixel : PAnsiChar; - IsTransparent , - WasTransparent : boolean; - OldTransparentColorIndex: byte; -begin - Result := False; - if (Image.Empty) then - exit; - - FImages.Add(Image); - - Pixel := Image.data; - Size := Image.Width * Image.Height; - - IsTransparent := Image.Transparent; - if (IsTransparent) then - OldTransparentColorIndex := Image.GraphicControlExtension.TransparentColorIndex - else - OldTransparentColorIndex := 0; // To avoid compiler warning - WasTransparent := False; - - (* - ** Sum up usage count for each color - *) - while (Size > 0) do - begin - // Ignore transparent pixels - if (not IsTransparent) or (ord(Pixel^) <> OldTransparentColorIndex) then - begin - // Check for invalid color index - if (ord(Pixel^) >= FCount) then - begin - Pixel^ := #0; // ***FIXME*** Isn't this an error condition? - Image.Warning(gsWarning, sInvalidColor); - end; - - with PHistogram^[ord(Pixel^)] do - begin - // Stop if any color reaches the max count - if (Count = high(integer)) then - break; - inc(Count); - end; - end else - WasTransparent := WasTransparent or IsTransparent; - inc(Pixel); - dec(Size); - end; - - (* - ** Clear frames transparency flag if the frame claimed to - ** be transparent, but wasn't - *) - if (IsTransparent and not WasTransparent) then - begin - Image.GraphicControlExtension.TransparentColorIndex := 0; - Image.GraphicControlExtension.Transparent := False; - end; - - Result := WasTransparent; -end; - -//: Removed unused color entries from the histogram -function THistogram.Prune: integer; -var - i, j : integer; -begin - (* - ** Sort by usage count - *) - FList.Sort(CompareCount); - - (* - ** Determine number of used colors - *) - for i := 0 to FCount-1 do - // Find first unused color entry - if (POptimizeEntry(FList[i])^.Count = 0) then - begin - // Zap unused colors - for j := i to FCount-1 do - POptimizeEntry(FList[j])^.Count := -1; // Use -1 to signal unused entry - // Remove unused entries - FCount := i; - FList.Count := FCount; - break; - end; - - Result := FCount; -end; - -//: Convert images from old color map to new color map -procedure THistogram.MapImages(UseTransparency: boolean; NewTransparentColorIndex: byte); -var - i : integer; - Size : integer; - Pixel : PAnsiChar; - ReverseMap : array[byte] of byte; - IsTransparent : boolean; - OldTransparentColorIndex: byte; -begin - (* - ** Build NewIndex map - *) - for i := 0 to List.Count-1 do - ReverseMap[POptimizeEntry(List[i])^.OldIndex] := POptimizeEntry(List[i])^.NewIndex; - - (* - ** Reorder all images using this color map - *) - for i := 0 to FImages.Count-1 do - with TGIFSubImage(FImages[i]) do - begin - Pixel := Data; - Size := Width * Height; - - // Determine frame transparency - IsTransparent := (Transparent) and (UseTransparency); - if (IsTransparent) then - begin - OldTransparentColorIndex := GraphicControlExtension.TransparentColorIndex; - // Map transparent color - GraphicControlExtension.TransparentColorIndex := NewTransparentColorIndex; - end else - OldTransparentColorIndex := 0; // To avoid compiler warning - - // Map all pixels to new color map - while (Size > 0) do - begin - // Map transparent pixels to the new transparent color index and... - if (IsTransparent) and (ord(Pixel^) = OldTransparentColorIndex) then - Pixel^ := AnsiChar(NewTransparentColorIndex) - else - // ... all other pixels to their new color index - Pixel^ := AnsiChar(ReverseMap[ord(Pixel^)]); - dec(size); - inc(Pixel); - end; - end; -end; - -constructor TColorMapOptimizer.Create(AImage: TGIFImage); -begin - inherited Create; - FImage := AImage; - FHistogramList := TList.Create; - FHistogram := TList.Create; -end; - -destructor TColorMapOptimizer.Destroy; -var - i : integer; -begin - FHistogram.Free; - - for i := FHistogramList.Count-1 downto 0 do - THistogram(FHistogramList[i]).Free; - FHistogramList.Free; - - inherited Destroy; -end; - -procedure TColorMapOptimizer.ProcessImage; -var - Hist : THistogram; - i : integer; - ProcessedImage : boolean; -begin - FUseTransparency := False; - (* - ** First process images using global color map - *) - if (FImage.GlobalColorMap.Count > 0) then - begin - Hist := THistogram.Create(FImage.GlobalColorMap); - ProcessedImage := False; - // Process all images that are using the global color map - for i := 0 to FImage.Images.Count-1 do - if (FImage.Images[i].ColorMap.Count = 0) and (not FImage.Images[i].Empty) then - begin - ProcessedImage := True; - // Note: Do not change order of statements. Shortcircuit evaluation not desired! - FUseTransparency := Hist.ProcessSubImage(FImage.Images[i]) or FUseTransparency; - end; - // Keep the histogram if any images used the global color map... - if (ProcessedImage) then - FHistogramList.Add(Hist) - else // ... otherwise delete it - Hist.Free; - end; - - (* - ** Next process images that have a local color map - *) - for i := 0 to FImage.Images.Count-1 do - if (FImage.Images[i].ColorMap.Count > 0) and (not FImage.Images[i].Empty) then - begin - Hist := THistogram.Create(FImage.Images[i].ColorMap); - FHistogramList.Add(Hist); - // Note: Do not change order of statements. Shortcircuit evaluation not desired! - FUseTransparency := Hist.ProcessSubImage(FImage.Images[i]) or FUseTransparency; - end; -end; - -procedure TColorMapOptimizer.MergeColors; -var - Entry, SameEntry : POptimizeEntry; - i : integer; -begin - (* - ** Sort by color value - *) - FHistogram.Sort(CompareColor); - - (* - ** Merge same colors - *) - SameEntry := POptimizeEntry(FHistogram[0]); - for i := 1 to FHistogram.Count-1 do - begin - Entry := POptimizeEntry(FHistogram[i]); - ASSERT(Entry^.Count > 0, 'Unused entry exported from THistogram'); - if (Entry^.Color.Value = SameEntry^.Color.Value) then - begin - // Transfer usage count to first entry - inc(SameEntry^.Count, Entry^.Count); - Entry^.Count := 0; // Use 0 to signal merged entry - Entry^.Color.SameAs := SameEntry; // Point to master - end else - SameEntry := Entry; - end; -end; - -procedure TColorMapOptimizer.MapColors; -var - i, j : integer; - Delta, BestDelta : integer; - BestIndex : integer; - MaxColors : integer; -begin - (* - ** Sort by usage count - *) - FHistogram.Sort(CompareCount); - - (* - ** Handle transparency - *) - if (FUseTransparency) then - MaxColors := 255 - else - MaxColors := 256; - - (* - ** Determine number of colors used (max 256) - *) - FFinalCount := FHistogram.Count; - for i := 0 to FFinalCount-1 do - if (i >= MaxColors) or (POptimizeEntry(FHistogram[i])^.Count = 0) then - begin - FFinalCount := i; - break; - end; - - (* - ** Build color map and reverse map for final entries - *) - for i := 0 to FFinalCount-1 do - begin - POptimizeEntry(FHistogram[i])^.NewIndex := i; - FColorMap[i] := POptimizeEntry(FHistogram[i])^.Color.Color; - end; - - (* - ** Map colors > 256 to colors <= 256 and build NewIndex color map - *) - for i := FFinalCount to FHistogram.Count-1 do - with POptimizeEntry(FHistogram[i])^ do - begin - // Entries with a usage count of -1 is unused - ASSERT(Count <> -1, 'Internal error: Unused entry exported'); - // Entries with a usage count of 0 has been merged with another entry - if (Count = 0) then - begin - // Use mapping of master entry - ASSERT(Color.SameAs.NewIndex < 256, 'Internal error: Mapping to unmapped color'); - NewIndex := Color.SameAs.NewIndex; - end else - begin - // Search for entry with nearest color value - BestIndex := 0; - BestDelta := 255*3; - for j := 0 to FFinalCount-1 do - begin - Delta := ABS((POptimizeEntry(FHistogram[j])^.Color.Color.Red - Color.Color.Red) + - (POptimizeEntry(FHistogram[j])^.Color.Color.Green - Color.Color.Green) + - (POptimizeEntry(FHistogram[j])^.Color.Color.Blue - Color.Color.Blue)); - if (Delta < BestDelta) then - begin - BestDelta := Delta; - BestIndex := j; - end; - end; - NewIndex := POptimizeEntry(FHistogram[BestIndex])^.NewIndex;; - end; - end; - - (* - ** Add transparency color to new color map - *) - if (FUseTransparency) then - begin - FNewTransparentColorIndex := FFinalCount; - FColorMap[FFinalCount].Red := 0; - FColorMap[FFinalCount].Green := 0; - FColorMap[FFinalCount].Blue := 0; - inc(FFinalCount); - end; -end; - -procedure TColorMapOptimizer.ReplaceColorMaps; -var - i : integer; -begin - // Zap all local color maps - for i := 0 to FImage.Images.Count-1 do - if (FImage.Images[i].ColorMap <> nil) then - FImage.Images[i].ColorMap.Clear; - // Store optimized global color map - FImage.GlobalColorMap.ImportColorMap(FColorMap, FFinalCount); - FImage.GlobalColorMap.Optimized := True; -end; - -procedure TColorMapOptimizer.Optimize; -var - Total : integer; - i, j : integer; -begin - // Stop all painters during optimize... - FImage.PaintStop; - // ...and prevent any new from starting while we are doing our thing - FImage.Painters.LockList; - try - - (* - ** Process all sub images - *) - ProcessImage; - - // Prune histograms and calculate total number of colors - Total := 0; - for i := 0 to FHistogramList.Count-1 do - inc(Total, THistogram(FHistogramList[i]).Prune); - - // Allocate global histogram - FHistogram.Clear; - FHistogram.Capacity := Total; - - // Move data pointers from local histograms to global histogram - for i := 0 to FHistogramList.Count-1 do - with THistogram(FHistogramList[i]) do - for j := 0 to Count-1 do - begin - ASSERT(POptimizeEntry(List[j])^.Count > 0, 'Unused entry exported from THistogram'); - FHistogram.Add(List[j]); - end; - - (* - ** Merge same colors - *) - MergeColors; - - (* - ** Build color map and NewIndex map for final entries - *) - MapColors; - - (* - ** Replace local colormaps with global color map - *) - ReplaceColorMaps; - - (* - ** Process images for each color map - *) - for i := 0 to FHistogramList.Count-1 do - THistogram(FHistogramList[i]).MapImages(FUseTransparency, FNewTransparentColorIndex); - - (* - ** Delete the frame's old bitmaps and palettes - *) - for i := 0 to FImage.Images.Count-1 do - begin - FImage.Images[i].HasBitmap := False; - FImage.Images[i].Palette := 0; - end; - - finally - FImage.Painters.UnlockList; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -// -// TGIFImage -// -//////////////////////////////////////////////////////////////////////////////// -constructor TGIFImage.Create; -begin - inherited Create; - FImages := TGIFImageList.Create(self); - FHeader := TGIFHeader.Create(self); - FPainters := TThreadList.Create; - FGlobalPalette := 0; - // Load defaults - FDrawOptions := GIFImageDefaultDrawOptions; - ColorReduction := GIFImageDefaultColorReduction; - FReductionBits := GIFImageDefaultColorReductionBits; - FDitherMode := GIFImageDefaultDitherMode; - FCompression := GIFImageDefaultCompression; - FThreadPriority := GIFImageDefaultThreadPriority; - FAnimationSpeed := GIFImageDefaultAnimationSpeed; - - FDrawBackgroundColor := clNone; - IsDrawing := False; - IsInsideGetPalette := False; - FForceFrame := -1; // 2004.03.09 - NewImage; -end; - -destructor TGIFImage.Destroy; -var - i : integer; -begin - PaintStop; - with FPainters.LockList do - try - for i := Count-1 downto 0 do - TGIFPainter(Items[i]).FImage := nil; - finally - FPainters.UnLockList; - end; - - Clear; - FPainters.Free; - FImages.Free; - FHeader.Free; - inherited Destroy; -end; - -procedure TGIFImage.Clear; -begin - PaintStop; - FreeBitmap; - FImages.Clear; - FHeader.ColorMap.Clear; - FHeader.Height := 0; - FHeader.Width := 0; - FHeader.Prepare; - Palette := 0; -end; - -procedure TGIFImage.NewImage; -begin - Clear; -end; - -function TGIFImage.GetVersion: TGIFVersion; -var - v : TGIFVersion; - i : integer; -begin - Result := gvUnknown; - for i := 0 to FImages.Count-1 do - begin - v := FImages[i].Version; - if (v > Result) then - Result := v; - if (v >= high(TGIFVersion)) then - break; - end; -end; - -function TGIFImage.GetColorResolution: integer; -var - i : integer; -begin - Result := FHeader.ColorResolution; - for i := 0 to FImages.Count-1 do - if (FImages[i].ColorResolution > Result) then - Result := FImages[i].ColorResolution; -end; - -function TGIFImage.GetBitsPerPixel: integer; -var - i : integer; -begin - Result := FHeader.BitsPerPixel; - for i := 0 to FImages.Count-1 do - if (FImages[i].BitsPerPixel > Result) then - Result := FImages[i].BitsPerPixel; -end; - -function TGIFImage.GetBackgroundColorIndex: BYTE; -begin - Result := FHeader.BackgroundColorIndex; -end; - -procedure TGIFImage.SetBackgroundColorIndex(const Value: BYTE); -begin - FHeader.BackgroundColorIndex := Value; -end; - -function TGIFImage.GetBackgroundColor: TColor; -begin - Result := FHeader.BackgroundColor; -end; - -procedure TGIFImage.SetBackgroundColor(const Value: TColor); -begin - FHeader.BackgroundColor := Value; -end; - -function TGIFImage.GetAspectRatio: BYTE; -begin - Result := FHeader.AspectRatio; -end; - -procedure TGIFImage.SetAspectRatio(const Value: BYTE); -begin - FHeader.AspectRatio := Value; -end; - -procedure TGIFImage.SetDrawOptions(Value: TGIFDrawOptions); -begin - if (FDrawOptions = Value) then - exit; - - if (DrawPainter <> nil) then - DrawPainter.Stop; - - FDrawOptions := Value; - // Zap all bitmaps - Pack; - Changed(self); -end; - -function TGIFImage.GetAnimate: Boolean; -begin // 2002.07.07 - Result:= goAnimate in DrawOptions; -end; - -procedure TGIFImage.SetAnimate(const Value: Boolean); -begin // 2002.07.07 - if Value then - DrawOptions:= DrawOptions + [goAnimate] - else - DrawOptions:= DrawOptions - [goAnimate]; -end; - -procedure TGIFImage.SetForceFrame(const Value: Integer); -begin // 2004.03.09 - FForceFrame := Value; - Changed(Self); -end; - -procedure TGIFImage.SetAnimationSpeed(Value: integer); -begin - if (Value < 0) then - Value := 0 - else if (Value > 1000) then - Value := 1000; - if (Value <> FAnimationSpeed) then - begin - FAnimationSpeed := Value; - // Use the FPainters threadlist to protect FDrawPainter from being modified - // by the thread while we mess with it - with FPainters.LockList do - try - if (FDrawPainter <> nil) then - FDrawPainter.AnimationSpeed := FAnimationSpeed; - finally - // Release the lock on FPainters to let paint thread kill itself - FPainters.UnLockList; - end; - end; -end; - -procedure TGIFImage.SetReductionBits(Value: integer); -begin - if (Value < 3) or (Value > 8) then - Error(sInvalidBitSize); - FReductionBits := Value; -end; - -procedure TGIFImage.OptimizeColorMap; -var - ColorMapOptimizer : TColorMapOptimizer; -begin - ColorMapOptimizer := TColorMapOptimizer.Create(self); - try - ColorMapOptimizer.Optimize; - finally - ColorMapOptimizer.Free; - end; -end; - -procedure TGIFImage.Optimize(Options: TGIFOptimizeOptions; - ColorReduction: TColorReduction; DitherMode: TDitherMode; - ReductionBits: integer); -var - i , - j : integer; - Delay : integer; - GCE : TGIFGraphicControlExtension; - ThisRect , - NextRect , - MergeRect : TRect; - Prog , - MaxProg : integer; - - function Scan(Buf: PAnsiChar; Value: Byte; Count: integer): boolean; assembler; - asm - PUSH EDI - MOV EDI, Buf - MOV ECX, Count - MOV AL, Value - REPNE SCASB - MOV EAX, False - JNE @@1 - MOV EAX, True -@@1:POP EDI - end; - -begin - if (Empty) then - exit; - // Stop all painters during optimize... - PaintStop; - // ...and prevent any new from starting while we are doing our thing - FPainters.LockList; - try - Progress(Self, psStarting, 0, False, Rect(0,0,0,0), sProgressOptimizing); - try - - Prog := 0; - MaxProg := Images.Count*6; - - // Sort color map by usage and remove unused entries - if (ooColorMap in Options) then - begin - // Optimize global color map - if (GlobalColorMap.Count > 0) then - GlobalColorMap.Optimize; - // Optimize local color maps - for i := 0 to Images.Count-1 do - begin - inc(Prog); - if (Images[i].ColorMap.Count > 0) then - begin - Images[i].ColorMap.Optimize; - Progress(Self, psRunning, MulDiv(Prog, 100, MaxProg), False, - Rect(0,0,0,0), sProgressOptimizing); - end; - end; - end; - - // Remove passive elements, pass 1 - if (ooCleanup in Options) then - begin - // Check for transparency flag without any transparent pixels - for i := 0 to Images.Count-1 do - begin - inc(Prog); - if (Images[i].Transparent) then - begin - if not(Scan(Images[i].Data, - Images[i].GraphicControlExtension.TransparentColorIndex, - Images[i].DataSize)) then - begin - Images[i].GraphicControlExtension.Transparent := False; - Progress(Self, psRunning, MulDiv(Prog, 100, MaxProg), False, - Rect(0,0,0,0), sProgressOptimizing); - end; - end; - end; - - // Change redundant disposal modes - for i := 0 to Images.Count-2 do - begin - inc(Prog); - if (Images[i].GraphicControlExtension <> nil) and - (Images[i].GraphicControlExtension.Disposal in [dmPrevious, dmBackground]) and - (not Images[i+1].Transparent) then - begin - ThisRect := Images[i].BoundsRect; - NextRect := Images[i+1].BoundsRect; - if (not IntersectRect(MergeRect, ThisRect, NextRect)) then - continue; - // If the next frame completely covers the current frame, - // change the disposal mode to dmNone - if (EqualRect(MergeRect, NextRect)) then - Images[i].GraphicControlExtension.Disposal := dmNone; - Progress(Self, psRunning, MulDiv(Prog, 100, MaxProg), False, - Rect(0,0,0,0), sProgressOptimizing); - end; - end; - end else - inc(Prog, 2*Images.Count); - - // Merge layers of equal pixels (remove redundant pixels) - if (ooMerge in Options) then - begin - // Merge from last to first to avoid intefering with merge - for i := Images.Count-1 downto 1 do - begin - inc(Prog); - j := i-1; - // If the "previous" frames uses dmPrevious disposal mode, we must - // instead merge with the frame before the previous - while (j > 0) and - ((Images[j].GraphicControlExtension <> nil) and - (Images[j].GraphicControlExtension.Disposal = dmPrevious)) do - dec(j); - // Merge - Images[i].Merge(Images[j]); - Progress(Self, psRunning, MulDiv(Prog, 100, MaxProg), False, - Rect(0,0,0,0), sProgressOptimizing); - end; - end else - inc(Prog, Images.Count); - - // Crop transparent areas - if (ooCrop in Options) then - begin - for i := Images.Count-1 downto 0 do - begin - inc(Prog); - if (not Images[i].Empty) and (Images[i].Transparent) then - begin - // Remember frames delay in case frame is deleted - Delay := Images[i].GraphicControlExtension.Delay; - // Crop - Images[i].Crop; - // If the frame was completely transparent we remove it - if (Images[i].Empty) then - begin - // Transfer delay to previous frame in case frame was deleted - if (i > 0) and (Images[i-1].Transparent) then - Images[i-1].GraphicControlExtension.Delay := - Images[i-1].GraphicControlExtension.Delay + Delay; - Images.Delete(i); - end; - Progress(Self, psRunning, MulDiv(Prog, 100, MaxProg), False, - Rect(0,0,0,0), sProgressOptimizing); - end; - end; - end else - inc(Prog, Images.Count); - - // Remove passive elements, pass 2 - inc(Prog, Images.Count); - if (ooCleanup in Options) then - begin - for i := Images.Count-1 downto 0 do - begin - // Remove comments and application extensions - for j := Images[i].Extensions.Count-1 downto 0 do - if (Images[i].Extensions[j] is TGIFCommentExtension) or - (Images[i].Extensions[j] is TGIFTextExtension) or - (Images[i].Extensions[j] is TGIFUnknownAppExtension) or - ((Images[i].Extensions[j] is TGIFAppExtNSLoop) and - ((i > 0) or (Images.Count = 1))) then - Images[i].Extensions.Delete(j); - if (Images[i].GraphicControlExtension <> nil) then - begin - GCE := Images[i].GraphicControlExtension; - // Zap GCE if all of the following are true: - // * No delay or only one image - // * Not transparent - // * No prompt - // * No disposal or only one image - if ((GCE.Delay = 0) or (Images.Count = 1)) and - (not GCE.Transparent) and - (not GCE.UserInput) and - ((GCE.Disposal in [dmNone, dmNoDisposal]) or (Images.Count = 1)) then - begin - GCE.Free; - end; - end; - // Zap frame if it has become empty - if (Images[i].Empty) and (Images[i].Extensions.Count = 0) then - Images[i].Free; - end; - Progress(Self, psRunning, MulDiv(Prog, 100, MaxProg), False, - Rect(0,0,0,0), sProgressOptimizing); - end else - - // Reduce color depth - if (ooReduceColors in Options) then - begin - if (ColorReduction = rmPalette) then - Error(sInvalidReduction); - {.TODO -oanme -cFeature : Implement ooReduceColors option. } - // Not implemented! - end; - finally - if ExceptObject = nil then - i := 100 - else - i := 0; - Progress(Self, psEnding, i, False, Rect(0,0,0,0), sProgressOptimizing); - end; - finally - FPainters.UnlockList; - end; -end; - -procedure TGIFImage.Pack; -var - i : integer; -begin - // Zap bitmaps and palettes - FreeBitmap; - Palette := 0; - for i := 0 to FImages.Count-1 do - begin - FImages[i].Bitmap := nil; - FImages[i].Palette := 0; - end; - - // Only pack if no global colormap and a single image - if (FHeader.ColorMap.Count > 0) or (FImages.Count <> 1) then - exit; - - // Copy local colormap to global - FHeader.ColorMap.Assign(FImages[0].ColorMap); - // Zap local colormap - FImages[0].ColorMap.Clear; -end; - -procedure TGIFImage.SaveToStream(Stream: TStream); -var - n : Integer; -begin - Progress(Self, psStarting, 0, False, Rect(0,0,0,0), sProgressSaving); - try - // Write header - FHeader.SaveToStream(Stream); - // Write images - FImages.SaveToStream(Stream); - // Write trailer - with TGIFTrailer.Create(self) do - try - SaveToStream(Stream); - finally - Free; - end; - finally - if ExceptObject = nil then - n := 100 - else - n := 0; - Progress(Self, psEnding, n, True, Rect(0,0,0,0), sProgressSaving); - end; -end; - -// 2006.07.09 -> -{$IFDEF FIXHEADER_WIDTHHEIGHT_SILENT} -procedure TGIFImage.FixHeaderWidthHeight; -var - i, w, h: Integer; -begin - for i := 0 to Images.Count - 1 do - begin - w := Images.SubImages[i].Left + Images.SubImages[i].Width; - h := Images.SubImages[i].Top + Images.SubImages[i].Height; - if w > Header.Width then - Header.Width := w; - if h > Header.Height then - Header.Height := h; - end; -end; -{$ENDIF} -// 2006.07.09 <- - -procedure TGIFImage.LoadFromStream(Stream: TStream); -var - n : Integer; - Position : integer; -begin - Progress(Self, psStarting, 0, False, Rect(0,0,0,0), sProgressLoading); - try - // Zap old image - Clear; - Position := Stream.Position; - try - // Read header - FHeader.LoadFromStream(Stream); - // Read images - FImages.LoadFromStream(Stream, self); - {$IFDEF FIXHEADER_WIDTHHEIGHT_SILENT} - FixHeaderWidthHeight; // 2006.07.09 - {$ENDIF} - // Read trailer - with TGIFTrailer.Create(self) do - try - LoadFromStream(Stream); - finally - Free; - end; - except - // Restore stream position in case of error. - // Not required, but "a nice thing to do" - Stream.Position := Position; - raise; - end; - finally - if ExceptObject = nil then - n := 100 - else - n := 0; - Progress(Self, psEnding, n, True, Rect(0,0,0,0), sProgressLoading); - end; -end; - -procedure TGIFImage.LoadFromResourceName(Instance: THandle; const ResName: String); -// 2002.07.07 -var - Stream: TCustomMemoryStream; -begin - Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA); - try - LoadFromStream(Stream); - finally - Stream.Free; - end; -end; - -function TGIFImage.GetBitmap: TBitmap; -begin - if not(Empty) then - begin - Result := FBitmap; - if (Result <> nil) then - exit; - FBitmap := TBitmap.Create; - Result := FBitmap; - FBitmap.OnChange := Changed; - // Use first image as default - if (Images.Count > 0) then - begin - if (Images[0].Width = Width) and (Images[0].Height = Height) then - begin - // Use first image as it has same dimensions - FBitmap.Assign(Images[0].Bitmap); - end else - begin - // Draw first image on bitmap - FBitmap.Palette := CopyPalette(Palette); - FBitmap.Height := Height; - FBitmap.Width := Width; - Images[0].Draw(FBitmap.Canvas, FBitmap.Canvas.ClipRect, False, False); - end; - end; - end else - Result := nil -end; - -// Create a new (empty) bitmap -function TGIFImage.NewBitmap: TBitmap; -begin - Result := FBitmap; - if (Result <> nil) then - exit; - FBitmap := TBitmap.Create; - Result := FBitmap; - FBitmap.OnChange := Changed; - // Draw first image on bitmap - FBitmap.Palette := CopyPalette(Palette); - FBitmap.Height := Height; - FBitmap.Width := Width; -end; - -procedure TGIFImage.FreeBitmap; -begin - if (DrawPainter <> nil) then - DrawPainter.Stop; - - if (FBitmap <> nil) then - begin - FBitmap.Free; - FBitmap := nil; - end; -end; - -function TGIFImage.Add(Source: TPersistent): integer; -var - Image : TGIFSubImage; -begin - Image := nil; // To avoid compiler warning - not needed. - if (Source is TGraphic) then - begin - Image := TGIFSubImage.Create(self); - try - Image.Assign(Source); - // ***FIXME*** Documentation should explain the inconsistency here: - // TGIFimage does not take ownership of Source after TGIFImage.Add() and - // therefore does not delete Source. - except - Image.Free; - raise; - end; - end else - if (Source is TGIFSubImage) then - Image := TGIFSubImage(Source) - else - Error(sUnsupportedClass); - - Result := FImages.Add(Image); - - FreeBitmap; - Changed(self); -end; - -function TGIFImage.GetEmpty: Boolean; -begin - Result := (FImages.Count = 0); -end; - -function TGIFImage.GetHeight: Integer; -begin - Result := FHeader.Height; -end; - -function TGIFImage.GetWidth: Integer; -begin - Result := FHeader.Width; -end; - -function TGIFImage.GetIsTransparent: Boolean; -var - i : integer; -begin - Result := False; - for i := 0 to Images.Count-1 do - if (Images[i].GraphicControlExtension <> nil) and - (Images[i].GraphicControlExtension.Transparent) then - begin - Result := True; - exit; - end; -end; - -function TGIFImage.Equals(Graphic: TGraphic): Boolean; -begin - Result := (Graphic = self); -end; - -function TGIFImage.GetPalette: HPALETTE; -begin - // Check for recursion - // (TGIFImage.GetPalette->TGIFSubImage.GetPalette->TGIFImage.GetPalette etc...) - if (IsInsideGetPalette) then - Error(sNoColorTable); - IsInsideGetPalette := True; - try - Result := 0; - if (FBitmap <> nil) and (FBitmap.Palette <> 0) then - // Use bitmaps own palette if possible - Result := FBitmap.Palette - else if (FGlobalPalette <> 0) then - // Or a previously exported global palette - Result := FGlobalPalette - else if (DoDither) then - begin - // or create a new dither palette - FGlobalPalette := WebPalette; - Result := FGlobalPalette; - end else - if (FHeader.ColorMap.Count > 0) then - begin - // or create a new if first time - FGlobalPalette := FHeader.ColorMap.ExportPalette; - Result := FGlobalPalette; - end else - if (FImages.Count > 0) then - // This can cause a recursion if no global palette exist and image[0] - // hasn't got one either. Checked by the IsInsideGetPalette semaphor. - Result := FImages[0].Palette; - finally - IsInsideGetPalette := False; - end; -end; - -procedure TGIFImage.SetPalette(Value: HPalette); -var - NeedNewBitmap : boolean; -begin - if (Value <> FGlobalPalette) then - begin - // Zap old palette - if (FGlobalPalette <> 0) then - DeleteObject(FGlobalPalette); - - // Zap bitmap unless new palette is same as bitmaps own - NeedNewBitmap := (FBitmap <> nil) and (Value <> FBitmap.Palette); - - // Use new palette - FGlobalPalette := Value; - - if (NeedNewBitmap) then - begin - // Need to create new bitmap and repaint - FreeBitmap; - PaletteModified := True; - Changed(Self); - end; - end; -end; - -// Obsolete -// procedure TGIFImage.Changed(Sender: TObject); -// begin -// inherited Changed(Sender); -// end; - -procedure TGIFImage.SetHeight(Value: Integer); -var - i : integer; -begin - for i := 0 to Images.Count-1 do - if (Images[i].Top + Images[i].Height > Value) then - Error(sBadHeight); - if (Value <> Header.Height) then - begin - Header.Height := Value; - FreeBitmap; - Changed(self); - end; -end; - -procedure TGIFImage.SetWidth(Value: Integer); -var - i : integer; -begin - for i := 0 to Images.Count-1 do - if (Images[i].Left + Images[i].Width > Value) then - Error(sBadWidth); - if (Value <> Header.Width) then - begin - Header.Width := Value; - FreeBitmap; - Changed(self); - end; -end; - -procedure TGIFImage.WriteData(Stream: TStream); -begin - if (GIFImageOptimizeOnStream) then - Optimize([ooCrop, ooMerge, ooCleanup, ooColorMap, ooReduceColors], rmNone, dmNearest, 8); - - inherited WriteData(Stream); -end; - -procedure TGIFImage.AssignTo(Dest: TPersistent); -begin - if (Dest is TBitmap) then - Dest.Assign(Bitmap) - else - inherited AssignTo(Dest); -end; - -{.TODO 1 -oanme -cImprovement : Better handling of TGIFImage.Assign(Empty TBitmap). } -procedure TGIFImage.Assign(Source: TPersistent); -var - i : integer; - Image : TGIFSubImage; -begin - if (Source = self) then - exit; - if (Source = nil) then - begin - Clear; - end else - // - // TGIFImage import - // - if (Source is TGIFImage) then - begin - Clear; - // Temporarily copy event handlers to be able to generate progress events - // during the copy and handle copy errors - OnProgress := TGIFImage(Source).OnProgress; - try - FOnWarning := TGIFImage(Source).OnWarning; - Progress(Self, psStarting, 0, False, Rect(0,0,0,0), sProgressCopying); - try - FHeader.Assign(TGIFImage(Source).Header); - FThreadPriority := TGIFImage(Source).ThreadPriority; - FDrawBackgroundColor := TGIFImage(Source).DrawBackgroundColor; - FDrawOptions := TGIFImage(Source).DrawOptions; - FColorReduction := TGIFImage(Source).ColorReduction; - FDitherMode := TGIFImage(Source).DitherMode; - FForceFrame := TGIFImage(Source).ForceFrame; // 2004.03.09 -// 2002.07.07 -> - FOnWarning:= TGIFImage(Source).FOnWarning; - FOnStartPaint:= TGIFImage(Source).FOnStartPaint; - FOnPaint:= TGIFImage(Source).FOnPaint; - FOnEndPaint:= TGIFImage(Source).FOnEndPaint; - FOnAfterPaint:= TGIFImage(Source).FOnAfterPaint; - FOnLoop:= TGIFImage(Source).FOnLoop; -// 2002.07.07 <- - for i := 0 to TGIFImage(Source).Images.Count-1 do - begin - Image := TGIFSubImage.Create(self); - Image.Assign(TGIFImage(Source).Images[i]); - Add(Image); - Progress(Self, psRunning, MulDiv((i+1), 100, TGIFImage(Source).Images.Count), - False, Rect(0,0,0,0), sProgressCopying); - end; - {$IFDEF FIXHEADER_WIDTHHEIGHT_SILENT} - FixHeaderWidthHeight; // 2006.07.09 - {$ENDIF} - finally - if ExceptObject = nil then - i := 100 - else - i := 0; - Progress(Self, psEnding, i, False, Rect(0,0,0,0), sProgressCopying); - end; - finally - // Reset event handlers - FOnWarning := nil; - OnProgress := nil; - end; - end else - // - // Import via TGIFSubImage.Assign - // - begin - Clear; - Image := TGIFSubImage.Create(self); - try - Image.Assign(Source); - Add(Image); - except - on E: EConvertError do - begin - Image.Free; - // Unsupported format - fall back to Source.AssignTo - inherited Assign(Source); - end; - else - // Unknown conversion error - Image.Free; - raise; - end; - end; -end; - -procedure TGIFImage.LoadFromClipboardFormat(AFormat: Word; AData: THandle; - APalette: HPALETTE); -{$IFDEF REGISTER_TGIFIMAGE} -var - Size : Longint; - Buffer : Pointer; - Stream : TMemoryStream; - Bmp : TBitmap; -{$ENDIF} // 2002.07.07 -begin // 2002.07.07 -{$IFDEF REGISTER_TGIFIMAGE} // 2002.07.07 - if (AData = 0) then - AData := GetClipboardData(AFormat); - if (AData <> 0) and (AFormat = CF_GIF) then - begin - // Get size and pointer to data - Size := GlobalSize(AData); - Buffer := GlobalLock(AData); - try - Stream := TMemoryStream.Create; - try - // Copy data to a stream - Stream.SetSize(Size); - Move(Buffer^, Stream.Memory^, Size); - // Load GIF from stream - LoadFromStream(Stream); - finally - Stream.Free; - end; - finally - GlobalUnlock(AData); - end; - end else - if (AData <> 0) and (AFormat = CF_BITMAP) then - begin - // No GIF on clipboard - try loading a bitmap instead - Bmp := TBitmap.Create; - try - Bmp.LoadFromClipboardFormat(AFormat, AData, APalette); - Assign(Bmp); - finally - Bmp.Free; - end; - end else - Error(sUnknownClipboardFormat); -{$ELSE} // 2002.07.07 - Error(sGIFToClipboard); // 2002.07.07 -{$ENDIF} // 2002.07.07 -end; - -procedure TGIFImage.SaveToClipboardFormat(var AFormat: Word; var AData: THandle; - var APalette: HPALETTE); -{$IFDEF REGISTER_TGIFIMAGE} -var - Stream : TMemoryStream; - Data : THandle; - Buffer : Pointer; -{$ENDIF} // 2002.07.07 -begin // 2002.07.07 -{$IFDEF REGISTER_TGIFIMAGE} // 2002.07.07 - if (Empty) then - exit; - // First store a bitmap version on the clipboard... - Bitmap.SaveToClipboardFormat(AFormat, AData, APalette); - // ...then store a GIF - Stream := TMemoryStream.Create; - try - // Save the GIF to a memory stream - SaveToStream(Stream); - Stream.Position := 0; - // Allocate some memory for the GIF data - Data := GlobalAlloc(HeapAllocFlags, Stream.Size); - try - if (Data <> 0) then - begin - Buffer := GlobalLock(Data); - try - // Copy GIF data from stream memory to clipboard memory - Move(Stream.Memory^, Buffer^, Stream.Size); - finally - GlobalUnlock(Data); - end; - // Transfer data to clipboard - if (SetClipboardData(CF_GIF, Data) = 0) then - Error(sFailedPaste); - end; - except - GlobalFree(Data); - raise; - end; - finally - Stream.Free; - end; -{$ELSE} // 2002.07.07 - Error(sGIFToClipboard); // 2002.07.07 -{$ENDIF} // 2002.07.07 -end; - -function TGIFImage.GetColorMap: TGIFColorMap; -begin - Result := FHeader.ColorMap; -end; - -function TGIFImage.GetDoDither: boolean; -begin - Result := (goDither in DrawOptions) and - (((goAutoDither in DrawOptions) and DoAutoDither) or - not(goAutoDither in DrawOptions)); -end; - -{$IFDEF VER9x} -procedure TGIFImage.Progress(Sender: TObject; Stage: TProgressStage; - PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); -begin - if Assigned(FOnProgress) then - FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg); -end; -{$ENDIF} - -procedure TGIFImage.StopDraw; -{$IFNDEF VER14_PLUS} // 2001.07.23 -var - Msg : TMsg; - ThreadWindow : HWND; -{$ENDIF} // 2001.07.23 -begin - repeat - // Use the FPainters threadlist to protect FDrawPainter from being modified - // by the thread while we mess with it - with FPainters.LockList do - try - if (FDrawPainter = nil) then - break; - - // Tell thread to terminate - FDrawPainter.Stop; - - // No need to wait for "thread" to terminate if running in main thread - if not(goAsync in FDrawPainter.DrawOptions) then - break; - - finally - // Release the lock on FPainters to let paint thread kill itself - FPainters.UnLockList; - end; - -{$IFDEF VER14_PLUS} -// 2002.07.07 - if (GetCurrentThreadID = MainThreadID) then - while CheckSynchronize do {loop}; -{$ELSE} - // Process Messages to make Synchronize work - // (Instead of Application.ProcessMessages) -//{$IFDEF VER14_PLUS} // 2001.07.23 -// Break; // 2001.07.23 -// Sleep(0); // Yield // 2001.07.23 -//{$ELSE} // 2001.07.23 - ThreadWindow := FindWindow('TThreadWindow', nil); - while PeekMessage(Msg, ThreadWindow, CM_DESTROYWINDOW, CM_EXECPROC, PM_REMOVE) do - begin - if (Msg.Message <> WM_QUIT) then - begin - TranslateMessage(Msg); - DispatchMessage(Msg); - end else - begin - PostQuitMessage(Msg.WParam); - exit; - end; - end; -{$ENDIF} // 2001.07.23 - Sleep(0); // Yield - - until (False); - FreeBitmap; -end; - -procedure TGIFImage.Draw(ACanvas: TCanvas; const Rect: TRect); -var - Canvas : TCanvas; - DestRect : TRect; -{$IFNDEF VER14_PLUS} // 2001.07.23 - Msg : TMsg; - ThreadWindow : HWND; -{$ENDIF} // 2001.07.23 - - procedure DrawTile(Rect: TRect; Bitmap: TBitmap); - var - Tile : TRect; - begin - if (goTile in FDrawOptions) then - begin - // Note: This design does not handle transparency correctly! - Tile.Left := Rect.Left; - Tile.Right := Tile.Left + Width; - while (Tile.Left < Rect.Right) do - begin - Tile.Top := Rect.Top; - Tile.Bottom := Tile.Top + Height; - while (Tile.Top < Rect.Bottom) do - begin - ACanvas.StretchDraw(Tile, Bitmap); - Tile.Top := Tile.Top + Height; - Tile.Bottom := Tile.Top + Height; - end; - Tile.Left := Tile.Left + Width; - Tile.Right := Tile.Left + Width; - end; - end else - ACanvas.StretchDraw(Rect, Bitmap); - end; - -begin - // Prevent recursion(s(s(s))) - if (IsDrawing) or (FImages.Count = 0) then - exit; - - IsDrawing := True; - try - // Copy bitmap to canvas if we are already drawing - // (or have drawn but are finished) - if (FImages.Count = 1) or // Only one image - (not (goAnimate in FDrawOptions)) then // Don't animate - begin - // 2004.03.09 -> - if (FForceFrame >= 0) and (FForceFrame < FImages.Count) then - FImages[FForceFrame].Draw(ACanvas, Rect, (goTransparent in FDrawOptions), (goTile in FDrawOptions)) - else - // 2004.03.09 <- - FImages[0].Draw(ACanvas, Rect, (goTransparent in FDrawOptions), (goTile in FDrawOptions)); - exit; - end else - if (FBitmap <> nil) and not(goDirectDraw in FDrawOptions) then - begin - DrawTile(Rect, Bitmap); - exit; - end; - - // Use the FPainters threadlist to protect FDrawPainter from being modified - // by the thread while we mess with it - with FPainters.LockList do - try - // If we are already painting on the canvas in goDirectDraw mode - // and at the same location, just exit and let the painter do - // its thing when it's ready - if (FDrawPainter <> nil) and (FDrawPainter.Canvas = ACanvas) and - EqualRect(FDrawPainter.Rect, Rect) then - exit; - - // Kill the current paint thread - StopDraw; - - if not(goDirectDraw in FDrawOptions) then - begin - // Create a bitmap to draw on - NewBitmap; - Canvas := FBitmap.Canvas; - DestRect := Canvas.ClipRect; - // Initialize bitmap canvas with background image - Canvas.CopyRect(DestRect, ACanvas, Rect); - end else - begin - Canvas := ACanvas; - DestRect := Rect; - end; - - // Create new paint thread - InternalPaint(@FDrawPainter, Canvas, DestRect, FDrawOptions); - - if (FDrawPainter <> nil) then - begin - // Launch thread - FDrawPainter.Start; - - if not(goDirectDraw in FDrawOptions) then - begin -{$IFDEF VER14_PLUS} -// 2002.07.07 - while (FDrawPainter <> nil) and (not FDrawPainter.Terminated) and - (not FDrawPainter.Started) do - begin - if not CheckSynchronize then - Sleep(0); // Yield - end; -{$ELSE} -//{$IFNDEF VER14_PLUS} // 2001.07.23 - ThreadWindow := FindWindow('TThreadWindow', nil); - // Wait for thread to render first frame - while (FDrawPainter <> nil) and (not FDrawPainter.Terminated) and - (not FDrawPainter.Started) do - // Process Messages to make Synchronize work - // (Instead of Application.ProcessMessages) - if PeekMessage(Msg, ThreadWindow, CM_DESTROYWINDOW, CM_EXECPROC, PM_REMOVE) then - begin - if (Msg.Message <> WM_QUIT) then - begin - TranslateMessage(Msg); - DispatchMessage(Msg); - end else - begin - PostQuitMessage(Msg.WParam); - exit; - end; - end else - Sleep(0); // Yield -{$ENDIF} // 2001.07.23 - // Draw frame to destination - DrawTile(Rect, Bitmap); - end; - end; - finally - FPainters.UnLockList; - end; - - finally - IsDrawing := False; - end; -end; - -// Internal pain(t) routine used by Draw() -function TGIFImage.InternalPaint(Painter: PGifPainter; ACanvas: TCanvas; - const Rect: TRect; Options: TGIFDrawOptions): TGIFPainter; -begin - if (Empty) or (Rect.Left >= Rect.Right) or (Rect.Top >= Rect.Bottom) then - begin - Result := nil; - if (Painter <> nil) then - Painter^ := Result; - exit; - end; - - // Draw in main thread if only one image - if (Images.Count = 1) then - Options := Options - [goAsync, goAnimate]; - - Result := TGIFPainter.CreateRef(Painter, self, ACanvas, Rect, Options); - FPainters.Add(Result); - Result.OnStartPaint := FOnStartPaint; - Result.OnPaint := FOnPaint; - Result.OnAfterPaint := FOnAfterPaint; - Result.OnLoop := FOnLoop; - Result.OnEndPaint := FOnEndPaint; - - if not(goAsync in Options) then - begin - // Run in main thread - Result.Execute; - // Note: Painter threads executing in the main thread are freed upon exit - // from the Execute method, so no need to do it here. - Result := nil; - if (Painter <> nil) then - Painter^ := Result; - end else - Result.Priority := FThreadPriority; -end; - -function TGIFImage.Paint(ACanvas: TCanvas; const Rect: TRect; - Options: TGIFDrawOptions): TGIFPainter; -begin - Result := InternalPaint(nil, ACanvas, Rect, Options); - if (Result <> nil) then - // Run in separate thread - Result.Start; -end; - -procedure TGIFImage.PaintStart; -var - i : integer; -begin - with FPainters.LockList do - try - for i := 0 to Count-1 do - TGIFPainter(Items[i]).Start; - finally - FPainters.UnLockList; - end; -end; - -procedure TGIFImage.PaintStop; -var - Ghosts : integer; - i : integer; -{$IFNDEF VER14_PLUS} // 2001.07.23 - Msg : TMsg; - ThreadWindow : HWND; -{$ENDIF} // 2001.07.23 - -{$IFNDEF VER14_PLUS} // 2001.07.23 - procedure KillThreads; - var - i : integer; - begin - with FPainters.LockList do - try - for i := Count-1 downto 0 do - if (goAsync in TGIFPainter(Items[i]).DrawOptions) then - begin - TerminateThread(TGIFPainter(Items[i]).Handle, 0); - Delete(i); - end; - finally - FPainters.UnLockList; - end; - end; -{$ENDIF} // 2001.07.23 - -begin - try - // Loop until all have died - repeat - with FPainters.LockList do - try - if (Count = 0) then - exit; - - // Signal painters to terminate - // Painters will attempt to remove them self from the - // painter list when they die - Ghosts := Count; - for i := Ghosts-1 downto 0 do - begin - if not(goAsync in TGIFPainter(Items[i]).DrawOptions) then - dec(Ghosts); - TGIFPainter(Items[i]).Stop; - end; - finally - FPainters.UnLockList; - end; - - // If all painters were synchronous, there's no purpose waiting for them - // to terminate, because they are running in the main thread. - if (Ghosts = 0) then - exit; -{$IFDEF VER14_PLUS} -// 2002.07.07 - if (GetCurrentThreadID = MainThreadID) then - while CheckSynchronize do {loop}; -{$ELSE} - // Process Messages to make TThread.Synchronize work - // (Instead of Application.ProcessMessages) -//{$IFDEF VER14_PLUS} // 2001.07.23 -// Exit; // 2001.07.23 -//{$ELSE} // 2001.07.23 - ThreadWindow := FindWindow('TThreadWindow', nil); - if (ThreadWindow = 0) then - begin - KillThreads; - Exit; - end; - while PeekMessage(Msg, ThreadWindow, CM_DESTROYWINDOW, CM_EXECPROC, PM_REMOVE) do - begin - if (Msg.Message <> WM_QUIT) then - begin - TranslateMessage(Msg); - DispatchMessage(Msg); - end else - begin - KillThreads; - Exit; - end; - end; -{$ENDIF} // 2001.07.23 - Sleep(0); - until (False); - finally - FreeBitmap; - end; -end; - -procedure TGIFImage.PaintPause; -var - i : integer; -begin - with FPainters.LockList do - try - for i := 0 to Count-1 do - TGIFPainter(Items[i]).Suspend; - finally - FPainters.UnLockList; - end; -end; - -procedure TGIFImage.PaintResume; -var - i : integer; -begin - // Implementation is currently same as PaintStart, but don't call PaintStart - // in case its implementation changes - with FPainters.LockList do - try - for i := 0 to Count-1 do - TGIFPainter(Items[i]).Start; - finally - FPainters.UnLockList; - end; -end; - -procedure TGIFImage.PaintRestart; -var - i : integer; -begin - with FPainters.LockList do - try - for i := 0 to Count-1 do - TGIFPainter(Items[i]).Restart; - finally - FPainters.UnLockList; - end; -end; - -procedure TGIFImage.Warning(Sender: TObject; Severity: TGIFSeverity; Message: string); -begin - if (Assigned(FOnWarning)) then - FOnWarning(Sender, Severity, Message); -end; - -{$IFDEF VER12_PLUS} - {$IFNDEF VER14_PLUS} // not anymore need for Delphi 6 and up // 2001.07.23 -type - TDummyThread = class(TThread) - protected - procedure Execute; override; - end; -procedure TDummyThread.Execute; -begin -end; - {$ENDIF} // 2001.07.23 -{$ENDIF} - -var - DesktopDC: HDC; -{$IFDEF VER12_PLUS} - {$IFNDEF VER14_PLUS} // not anymore need for Delphi 6 and up // 2001.07.23 - DummyThread: TThread; - {$ENDIF} // 2001.07.23 -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// -// Initialization -// -//////////////////////////////////////////////////////////////////////////////// - -initialization -{$IFDEF REGISTER_TGIFIMAGE} - TPicture.RegisterFileFormat('GIF', sGIFImageFile, TGIFImage); -// 2008.10.19 -> -{$IFDEF VER20_PLUS} - CF_GIF := RegisterClipboardFormat(PWideChar(sGIFImageFile)); -{$ELSE} - CF_GIF := RegisterClipboardFormat(PAnsiChar(sGIFImageFile)); -{$ENDIF} -// 2008.10.19 <- - TPicture.RegisterClipboardFormat(CF_GIF, TGIFImage); -{$ENDIF} - DesktopDC := GetDC(0); - try - PaletteDevice := (GetDeviceCaps(DesktopDC, BITSPIXEL) * GetDeviceCaps(DesktopDC, PLANES) <= 8); - DoAutoDither := PaletteDevice; - finally - ReleaseDC(0, DesktopDC); - end; - -{$IFDEF VER9x} - // Note: This doesn't return the same palette as the Delphi 3 system palette - // since the true system palette contains 20 entries and the Delphi 3 system - // palette only contains 16. - // For our purpose this doesn't matter since we do not care about the actual - // colors (or their number) in the palette. - // Stock objects doesn't have to be deleted. - SystemPalette16 := GetStockObject(DEFAULT_PALETTE); -{$ENDIF} -{$IFDEF VER12_PLUS} - // Make sure that at least one thread always exist. - // This is done to circumvent a race condition bug in Delphi 4.x and later: - // When threads are deleted and created in rapid succesion, a situation might - // arise where the thread window is deleted *after* the threads it controls - // has been created. See the Delphi Bug Lists for more information. - {$IFNDEF VER14_PLUS} // not anymore need for Delphi 6 and up // 2001.07.23 - DummyThread := TDummyThread.Create(True); - {$ENDIF} // 2001.07.23 -{$ENDIF} - -//////////////////////////////////////////////////////////////////////////////// -// -// Finalization -// -//////////////////////////////////////////////////////////////////////////////// -finalization - ExtensionList.Free; - AppExtensionList.Free; -{$IFNDEF VER9x} - {$IFDEF REGISTER_TGIFIMAGE} - TPicture.UnregisterGraphicClass(TGIFImage); - {$ENDIF} - {$IFDEF VER100} - if (pf8BitBitmap <> nil) then - pf8BitBitmap.Free; - {$ENDIF} -{$ENDIF} -{$IFDEF VER12_PLUS} - {$IFNDEF VER14_PLUS} // not anymore need for Delphi 6 and up // 2001.07.23 - if (DummyThread <> nil) then -// 2006.10.16 -> -// DummyThread.Free; - begin - DummyThread.Resume; - DummyThread.WaitFor; - DummyThread.Free; - end; -// 2006.10.16 <- - {$ENDIF} // 2001.07.23 -{$ENDIF} -end. - diff --git a/Src/3rdParty/LICENSE b/Src/3rdParty/LICENSE deleted file mode 100644 index b733afad0..000000000 --- a/Src/3rdParty/LICENSE +++ /dev/null @@ -1,16 +0,0 @@ -Files in the Src/3rdParty directory are licensed as follows: - -GIFImage.pas ------------- -Covered by the "TGifImage" license. See Docs/License.html#tgifimage. - -LVEx.pas --------- -This file, and the accompanying resource file (LVEx.res), are freeware copyright -(c) 1999-2009 Vadim Crits. For details of the terms and conditions of use see -Docs/License.html#tlistviewex. - -All Other Files ---------------- -All other files in the directory include licensing information in their -comments. \ No newline at end of file diff --git a/Src/3rdParty/PJMD5.pas b/Src/3rdParty/PJMD5.pas index 4cb0a9fea..f9d57b00b 100644 --- a/Src/3rdParty/PJMD5.pas +++ b/Src/3rdParty/PJMD5.pas @@ -1,7 +1,7 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * * Copyright (C) 2010-2014, Peter Johnson (www.delphidabbler.com). * diff --git a/Src/3rdParty/PJShellFolders.pas b/Src/3rdParty/PJShellFolders.pas index ca27208d6..c333b8021 100644 --- a/Src/3rdParty/PJShellFolders.pas +++ b/Src/3rdParty/PJShellFolders.pas @@ -1,7 +1,7 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * * Copyright (C) 2001-2014, Peter Johnson (www.delphidabbler.com). * diff --git a/Src/3rdParty/PJStreamWrapper.pas b/Src/3rdParty/PJStreamWrapper.pas index 51e3f22e6..fbbdf13fe 100644 --- a/Src/3rdParty/PJStreamWrapper.pas +++ b/Src/3rdParty/PJStreamWrapper.pas @@ -1,7 +1,7 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * * Copyright (C) 2000-2014, Peter Johnson (www.delphidabbler.com). * diff --git a/Src/3rdParty/PJSysInfo.pas b/Src/3rdParty/PJSysInfo.pas index 8a4fbda50..342fd7750 100644 --- a/Src/3rdParty/PJSysInfo.pas +++ b/Src/3rdParty/PJSysInfo.pas @@ -1,12 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2001-2020, Peter Johnson (@delphidabbler). - * - * $Rev: 2023 $ - * $Date: 2020-03-17 05:00:45 +0000 (Tue, 17 Mar 2020) $ + * Copyright (C) 2001-2024, Peter Johnson (https://gravatar.com/delphidabbler). * * This unit contains various static classes, constants, type definitions and * global variables for use in providing information about the host computer and @@ -24,39 +21,16 @@ * 3: When run on operating systems up to and including Windows 8 running the * host program in compatibility mode causes some variables and TPJOSInfo * methods to be "spoofed" into returning information about the emulated - * OS. When run on Windows 8.1 and later details of the actual host - * operating system are always returned and the emulated OS is ignored. - * - * ACKNOWLEDGEMENTS - * - * Thanks to the following who have contributed to this project: - * - * - Guillermo Fazzolari (bug fix in v2.0.1) - * - * - Laurent Pierre (Many PRODUCT_* constants and suggested GetProductInfo API - * code used in v3.0 and later) - * - * - Rich Habedank (bug fix in r228 and testing of bug fixes reported as - * issues #31 (https://sourceforge.net/p/ddablib/tickets/31/) and #33 - * (https://sourceforge.net/p/ddablib/tickets/33/) - * - * The project also draws on the work of: - * - * - Achim Kalwa <delphi@achim-kalwa.de> who translated the versionhelpers.h - * header into Pascal. Some of the IsReallyWindowsXXXXOrGreater methods of - * TPJOSInfo and the TestWindowsVersion routine are based closely on his - * work. + * OS. When run on Windows 8.1 details of the actual host operating system + * are always returned and the emulated OS is ignored. * - * - Brendan grant for his ideas presented in the Code Project article at - * http://bit.ly/1mDKTu3 + * 4: On Windows 10 and later the correct operating system will only be + * reported if the application declares the operating systems it supports + * in its manifest. * - * - Kendall Sullivan for the code on which TPJComputerInfo.IsAdmin is based. - * See http://edn.embarcadero.com/article/26752. - * - * - norgepaul for the code on which TPJComputerInfo.IsUACActive is based. See - * his answer on Stack Overflow at http://tinyurl.com/avlztmg. + * ACKNOWLEDGEMENTS * - * ***** END LICENSE BLOCK ***** + * See Docs/Acknowledgements.md } @@ -85,6 +59,7 @@ {$UNDEF RTLNAMESPACES} // No support for RTL namespaces in unit names {$UNDEF HASUNIT64} // UInt64 type not defined {$UNDEF INLINEMETHODS} // No support for inline methods +{$UNDEF HASTBYTES} // TBytes not defined // Undefine facilities not available in earlier compilers // Note: Delphi 1 to 3 is not included since the code will not compile on these @@ -106,6 +81,9 @@ {$IF CompilerVersion >= 24.0} // Delphi XE3 and later {$LEGACYIFEND ON} // NOTE: this must come before all $IFEND directives {$IFEND} + {$IF CompilerVersion >= 18.5} // Delphi 2007 Win32 and later + {$DEFINE HASTBYTES} + {$IFEND} {$IF CompilerVersion >= 23.0} // Delphi XE2 and later {$DEFINE RTLNAMESPACES} {$IFEND} @@ -141,6 +119,11 @@ interface System.SysUtils, System.Classes, Winapi.Windows; {$ENDIF} +{$IFNDEF HASTBYTES} +// Compiler doesn't have TBytes: define it +type + TBytes = array of Byte; +{$ENDIF} type // Windows types not defined in all supported Delphi VCLs @@ -260,101 +243,195 @@ interface // These Windows-defined constants are required for use with the // GetProductInfo API call used with Windows Vista and later - // ** Thanks to Laurent Pierre for providing these definitions. - // ** Additional definitions were obtained from - // http://msdn.microsoft.com/en-us/library/ms724358 - PRODUCT_BUSINESS = $00000006; - PRODUCT_BUSINESS_N = $00000010; - PRODUCT_CLUSTER_SERVER = $00000012; - PRODUCT_CLUSTER_SERVER_V = $00000040; - PRODUCT_CORE = $00000065; - PRODUCT_CORE_N = $00000062; - PRODUCT_CORE_COUNTRYSPECIFIC = $00000063; - PRODUCT_CORE_SINGLELANGUAGE = $00000064; - PRODUCT_DATACENTER_EVALUATION_SERVER = $00000050; - PRODUCT_DATACENTER_SERVER = $00000008; - PRODUCT_DATACENTER_SERVER_CORE = $0000000C; - PRODUCT_DATACENTER_SERVER_CORE_V = $00000027; - PRODUCT_DATACENTER_SERVER_V = $00000025; - PRODUCT_EDUCATION = $00000079; - PRODUCT_EDUCATION_N = $0000007A; - PRODUCT_ENTERPRISE = $00000004; - PRODUCT_ENTERPRISE_E = $00000046; - PRODUCT_ENTERPRISE_N_EVALUATION = $00000054; - PRODUCT_ENTERPRISE_N = $0000001B; - PRODUCT_ENTERPRISE_EVALUATION = $00000048; - PRODUCT_ENTERPRISE_SERVER = $0000000A; - PRODUCT_ENTERPRISE_SERVER_CORE = $0000000E; - PRODUCT_ENTERPRISE_SERVER_CORE_V = $00000029; - PRODUCT_ENTERPRISE_SERVER_IA64 = $0000000F; - PRODUCT_ENTERPRISE_SERVER_V = $00000026; - PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT = $0000003B; - PRODUCT_ESSENTIALBUSINESS_SERVER_ADDL = $0000003C; - PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC = $0000003D; - PRODUCT_ESSENTIALBUSINESS_SERVER_ADDLSVC = $0000003E; - PRODUCT_HOME_BASIC = $00000002; - PRODUCT_HOME_BASIC_E = $00000043; - PRODUCT_HOME_BASIC_N = $00000005; - PRODUCT_HOME_PREMIUM = $00000003; - PRODUCT_HOME_PREMIUM_E = $00000044; - PRODUCT_HOME_PREMIUM_N = $0000001A; - PRODUCT_HOME_PREMIUM_SERVER = $00000022; - PRODUCT_HOME_SERVER = $00000013; - PRODUCT_HYPERV = $0000002A; - PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT = $0000001E; - PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING = $00000020; - PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY = $0000001F; - PRODUCT_MOBILE_CORE = $00000068; - PRODUCT_MOBILE_ENTERPRISE = $00000085; - PRODUCT_MULTIPOINT_STANDARD_SERVER = $0000004C; - PRODUCT_MULTIPOINT_PREMIUM_SERVER = $0000004D; - PRODUCT_PROFESSIONAL = $00000030; - PRODUCT_PROFESSIONAL_E = $00000045; - PRODUCT_PROFESSIONAL_N = $00000031; - PRODUCT_PROFESSIONAL_WMC = $00000067; - PRODUCT_SB_SOLUTION_SERVER = $00000032; - PRODUCT_SB_SOLUTION_SERVER_EM = $00000036; - PRODUCT_SERVER_FOR_SB_SOLUTIONS = $00000033; - PRODUCT_SERVER_FOR_SB_SOLUTIONS_EM = $00000037; - PRODUCT_SERVER_FOR_SMALLBUSINESS = $00000018; - PRODUCT_SERVER_FOR_SMALLBUSINESS_V = $00000023; - PRODUCT_SERVER_FOUNDATION = $00000021; - PRODUCT_SMALLBUSINESS_SERVER = $00000009; - PRODUCT_SMALLBUSINESS_SERVER_PREMIUM = $00000019; - PRODUCT_SMALLBUSINESS_SERVER_PREMIUM_CORE = $0000003F; - PRODUCT_SOLUTION_EMBEDDEDSERVER = $00000038; - PRODUCT_STANDARD_EVALUATION_SERVER = $0000004F; - PRODUCT_STANDARD_SERVER = $00000007; - PRODUCT_STANDARD_SERVER_CORE = $0000000D; - PRODUCT_STANDARD_SERVER_V = $00000024; - PRODUCT_STANDARD_SERVER_CORE_V = $00000028; - PRODUCT_STANDARD_SERVER_SOLUTIONS = $00000034; - PRODUCT_STANDARD_SERVER_SOLUTIONS_CORE = $00000035; - PRODUCT_STARTER = $0000000B; - PRODUCT_STARTER_E = $00000042; - PRODUCT_STARTER_N = $0000002F; - PRODUCT_STORAGE_ENTERPRISE_SERVER = $00000017; - PRODUCT_STORAGE_ENTERPRISE_SERVER_CORE = $0000002E; - PRODUCT_STORAGE_EXPRESS_SERVER = $00000014; - PRODUCT_STORAGE_EXPRESS_SERVER_CORE = $0000002B; - PRODUCT_STORAGE_STANDARD_EVALUATION_SERVER = $00000060; - PRODUCT_STORAGE_STANDARD_SERVER = $00000015; - PRODUCT_STORAGE_STANDARD_SERVER_CORE = $0000002C; - PRODUCT_STORAGE_WORKGROUP_EVALUATION_SERVER = $0000005F; - PRODUCT_STORAGE_WORKGROUP_SERVER = $00000016; - PRODUCT_STORAGE_WORKGROUP_SERVER_CORE = $0000002D; - PRODUCT_UNDEFINED = $00000000; - PRODUCT_ULTIMATE = $00000001; - PRODUCT_ULTIMATE_E = $00000047; - PRODUCT_ULTIMATE_N = $0000001C; - PRODUCT_WEB_SERVER = $00000011; - PRODUCT_WEB_SERVER_CORE = $0000001D; - PRODUCT_UNLICENSED = $ABCDABCD; + // NOTE: PRODUCT_xxx constants marked with an asterisk comment have no + // associated description hard wired into this unit. + // ** Thanks to Laurent Pierre for providing these definitions originally. + // ** Subsequent additions were obtained from https://tinyurl.com/3rhhbs2z + // ** and the Windows 11 24H2 SDK + PRODUCT_UNDEFINED = $00000000; + PRODUCT_ULTIMATE = $00000001; + PRODUCT_HOME_BASIC = $00000002; + PRODUCT_HOME_PREMIUM = $00000003; + PRODUCT_ENTERPRISE = $00000004; + PRODUCT_HOME_BASIC_N = $00000005; + PRODUCT_BUSINESS = $00000006; + PRODUCT_STANDARD_SERVER = $00000007; + PRODUCT_DATACENTER_SERVER = $00000008; + PRODUCT_SMALLBUSINESS_SERVER = $00000009; + PRODUCT_ENTERPRISE_SERVER = $0000000A; + PRODUCT_STARTER = $0000000B; + PRODUCT_DATACENTER_SERVER_CORE = $0000000C; + PRODUCT_STANDARD_SERVER_CORE = $0000000D; + PRODUCT_ENTERPRISE_SERVER_CORE = $0000000E; + PRODUCT_ENTERPRISE_SERVER_IA64 = $0000000F; + PRODUCT_BUSINESS_N = $00000010; + PRODUCT_WEB_SERVER = $00000011; + PRODUCT_CLUSTER_SERVER = $00000012; + PRODUCT_HOME_SERVER = $00000013; + PRODUCT_STORAGE_EXPRESS_SERVER = $00000014; + PRODUCT_STORAGE_STANDARD_SERVER = $00000015; + PRODUCT_STORAGE_WORKGROUP_SERVER = $00000016; + PRODUCT_STORAGE_ENTERPRISE_SERVER = $00000017; + PRODUCT_SERVER_FOR_SMALLBUSINESS = $00000018; + PRODUCT_SMALLBUSINESS_SERVER_PREMIUM = $00000019; + PRODUCT_HOME_PREMIUM_N = $0000001A; + PRODUCT_ENTERPRISE_N = $0000001B; + PRODUCT_ULTIMATE_N = $0000001C; + PRODUCT_WEB_SERVER_CORE = $0000001D; + PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT = $0000001E; + PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY = $0000001F; + PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING = $00000020; + PRODUCT_SERVER_FOUNDATION = $00000021; + PRODUCT_HOME_PREMIUM_SERVER = $00000022; + PRODUCT_SERVER_FOR_SMALLBUSINESS_V = $00000023; + PRODUCT_STANDARD_SERVER_V = $00000024; + PRODUCT_DATACENTER_SERVER_V = $00000025; + PRODUCT_ENTERPRISE_SERVER_V = $00000026; + PRODUCT_DATACENTER_SERVER_CORE_V = $00000027; + PRODUCT_STANDARD_SERVER_CORE_V = $00000028; + PRODUCT_ENTERPRISE_SERVER_CORE_V = $00000029; + PRODUCT_HYPERV = $0000002A; + PRODUCT_STORAGE_EXPRESS_SERVER_CORE = $0000002B; + PRODUCT_STORAGE_STANDARD_SERVER_CORE = $0000002C; + PRODUCT_STORAGE_WORKGROUP_SERVER_CORE = $0000002D; + PRODUCT_STORAGE_ENTERPRISE_SERVER_CORE = $0000002E; + PRODUCT_STARTER_N = $0000002F; + PRODUCT_PROFESSIONAL = $00000030; + PRODUCT_PROFESSIONAL_N = $00000031; + PRODUCT_SB_SOLUTION_SERVER = $00000032; + PRODUCT_SERVER_FOR_SB_SOLUTIONS = $00000033; + PRODUCT_STANDARD_SERVER_SOLUTIONS = $00000034; + PRODUCT_STANDARD_SERVER_SOLUTIONS_CORE = $00000035; + PRODUCT_SB_SOLUTION_SERVER_EM = $00000036; + PRODUCT_SERVER_FOR_SB_SOLUTIONS_EM = $00000037; + PRODUCT_SOLUTION_EMBEDDEDSERVER = $00000038; + PRODUCT_SOLUTION_EMBEDDEDSERVER_CORE = $00000039; // * + PRODUCT_PROFESSIONAL_EMBEDDED = $0000003A; // * + PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT = $0000003B; + PRODUCT_ESSENTIALBUSINESS_SERVER_ADDL = $0000003C; + PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC = $0000003D; + PRODUCT_ESSENTIALBUSINESS_SERVER_ADDLSVC = $0000003E; + PRODUCT_SMALLBUSINESS_SERVER_PREMIUM_CORE = $0000003F; + PRODUCT_CLUSTER_SERVER_V = $00000040; + PRODUCT_EMBEDDED = $00000041; // * + PRODUCT_STARTER_E = $00000042; + PRODUCT_HOME_BASIC_E = $00000043; + PRODUCT_HOME_PREMIUM_E = $00000044; + PRODUCT_PROFESSIONAL_E = $00000045; + PRODUCT_ENTERPRISE_E = $00000046; + PRODUCT_ULTIMATE_E = $00000047; + PRODUCT_ENTERPRISE_EVALUATION = $00000048; + PRODUCT_MULTIPOINT_STANDARD_SERVER = $0000004C; + PRODUCT_MULTIPOINT_PREMIUM_SERVER = $0000004D; + PRODUCT_STANDARD_EVALUATION_SERVER = $0000004F; + PRODUCT_DATACENTER_EVALUATION_SERVER = $00000050; + PRODUCT_ENTERPRISE_N_EVALUATION = $00000054; + PRODUCT_EMBEDDED_AUTOMOTIVE = $00000055; // * + PRODUCT_EMBEDDED_INDUSTRY_A = $00000056; // * + PRODUCT_THINPC = $00000057; // * + PRODUCT_EMBEDDED_A = $00000058; // * + PRODUCT_EMBEDDED_INDUSTRY = $00000059; // * + PRODUCT_EMBEDDED_E = $0000005A; // * + PRODUCT_EMBEDDED_INDUSTRY_E = $0000005B; // * + PRODUCT_EMBEDDED_INDUSTRY_A_E = $0000005C; // * + PRODUCT_STORAGE_WORKGROUP_EVALUATION_SERVER = $0000005F; + PRODUCT_STORAGE_STANDARD_EVALUATION_SERVER = $00000060; + PRODUCT_CORE_ARM = $00000061; + PRODUCT_CORE_N = $00000062; + PRODUCT_CORE_COUNTRYSPECIFIC = $00000063; + PRODUCT_CORE_SINGLELANGUAGE = $00000064; + PRODUCT_CORE = $00000065; + PRODUCT_PROFESSIONAL_WMC = $00000067; + PRODUCT_MOBILE_CORE = $00000068; + PRODUCT_EMBEDDED_INDUSTRY_EVAL = $00000069; // * + PRODUCT_EMBEDDED_INDUSTRY_E_EVAL = $0000006A; // * + PRODUCT_EMBEDDED_EVAL = $0000006B; // * + PRODUCT_EMBEDDED_E_EVAL = $0000006C; // * + PRODUCT_NANO_SERVER = $0000006D; // * + PRODUCT_CLOUD_STORAGE_SERVER = $0000006E; // * + PRODUCT_CORE_CONNECTED = $0000006F; // * + PRODUCT_PROFESSIONAL_STUDENT = $00000070; // * + PRODUCT_CORE_CONNECTED_N = $00000071; // * + PRODUCT_PROFESSIONAL_STUDENT_N = $00000072; // * + PRODUCT_CORE_CONNECTED_SINGLELANGUAGE = $00000073; // * + PRODUCT_CORE_CONNECTED_COUNTRYSPECIFIC = $00000074; // * + PRODUCT_CONNECTED_CAR = $00000075; // * + PRODUCT_INDUSTRY_HANDHELD = $00000076; // * + PRODUCT_PPI_PRO = $00000077; // * + PRODUCT_ARM64_SERVER = $00000078; // * + PRODUCT_EDUCATION = $00000079; + PRODUCT_EDUCATION_N = $0000007A; + PRODUCT_IOTUAP = $0000007B; + PRODUCT_CLOUD_HOST_INFRASTRUCTURE_SERVER = $0000007C; // * + PRODUCT_ENTERPRISE_S = $0000007D; + PRODUCT_ENTERPRISE_S_N = $0000007E; + PRODUCT_PROFESSIONAL_S = $0000007F; // * + PRODUCT_PROFESSIONAL_S_N = $00000080; // * + PRODUCT_ENTERPRISE_S_EVALUATION = $00000081; + PRODUCT_ENTERPRISE_S_N_EVALUATION = $00000082; + PRODUCT_IOTUAPCOMMERCIAL = $00000083; + PRODUCT_MOBILE_ENTERPRISE = $00000085; + PRODUCT_HOLOGRAPHIC = $00000087; // * + PRODUCT_HOLOGRAPHIC_BUSINESS = $00000088; // * + PRODUCT_PRO_SINGLE_LANGUAGE = $0000008A; // * + PRODUCT_PRO_CHINA = $0000008B; // * + PRODUCT_ENTERPRISE_SUBSCRIPTION = $0000008C; // * + PRODUCT_ENTERPRISE_SUBSCRIPTION_N = $0000008D; // * + PRODUCT_DATACENTER_NANO_SERVER = $0000008F; + PRODUCT_STANDARD_NANO_SERVER = $00000090; + PRODUCT_DATACENTER_A_SERVER_CORE = $00000091; + PRODUCT_STANDARD_A_SERVER_CORE = $00000092; + PRODUCT_DATACENTER_WS_SERVER_CORE = $00000093; + PRODUCT_STANDARD_WS_SERVER_CORE = $00000094; + PRODUCT_UTILITY_VM = $00000095; // * + PRODUCT_DATACENTER_EVALUATION_SERVER_CORE = $0000009F; // * + PRODUCT_STANDARD_EVALUATION_SERVER_CORE = $000000A0; // * + PRODUCT_PRO_WORKSTATION = $000000A1; + PRODUCT_PRO_WORKSTATION_N = $000000A2; + PRODUCT_PRO_FOR_EDUCATION = $000000A4; + PRODUCT_PRO_FOR_EDUCATION_N = $000000A5; // * + PRODUCT_AZURE_SERVER_CORE = $000000A8; // * + PRODUCT_AZURE_NANO_SERVER = $000000A9; // * + PRODUCT_ENTERPRISEG = $000000AB; // * + PRODUCT_ENTERPRISEGN = $000000AC; // * + PRODUCT_SERVERRDSH = $000000AF; + PRODUCT_CLOUD = $000000B2; // * + PRODUCT_CLOUDN = $000000B3; // * + PRODUCT_HUBOS = $000000B4; // * + PRODUCT_ONECOREUPDATEOS = $000000B6; // * + PRODUCT_CLOUDE = $000000B7; // * + PRODUCT_IOTOS = $000000B9; // * + PRODUCT_CLOUDEN = $000000BA; // * + PRODUCT_IOTEDGEOS = $000000BB; // * + PRODUCT_IOTENTERPRISE = $000000BC; + PRODUCT_LITE = $000000BD; // * + PRODUCT_IOTENTERPRISE_S = $000000BF; + PRODUCT_XBOX_SYSTEMOS = $000000C0; // * + PRODUCT_XBOX_GAMEOS = $000000C2; // * + PRODUCT_XBOX_ERAOS = $000000C3; // * + PRODUCT_XBOX_DURANGOHOSTOS = $000000C4; // * + PRODUCT_XBOX_SCARLETTHOSTOS = $000000C5; // * + PRODUCT_XBOX_KEYSTONE = $000000C6; // * + PRODUCT_AZURE_SERVER_CLOUDHOST = $000000C7; // * + PRODUCT_AZURE_SERVER_CLOUDMOS = $000000C8; // * + PRODUCT_CLOUDEDITIONN = $000000CA; // * + PRODUCT_CLOUDEDITION = $000000CB; // * + PRODUCT_VALIDATION = $000000CC; // * + PRODUCT_IOTENTERPRISESK = $000000CD; // * + PRODUCT_IOTENTERPRISEK = $000000CE; // * + PRODUCT_IOTENTERPRISESEVAL = $000000CF; // * + PRODUCT_AZURE_SERVER_AGENTBRIDGE = $000000D0; // * + PRODUCT_AZURE_SERVER_NANOHOST = $000000D1; // * + PRODUCT_WNC = $000000D2; // * + PRODUCT_AZURESTACKHCI_SERVER_CORE = $00000196; // * + PRODUCT_DATACENTER_SERVER_AZURE_EDITION = $00000197; + PRODUCT_DATACENTER_SERVER_CORE_AZURE_EDITION = $00000198; // * + PRODUCT_UNLICENSED = $ABCDABCD; // These constants are required for use with GetSystemMetrics to detect // certain editions. GetSystemMetrics returns non-zero when passed these flags // if the associated edition is present. - // Obtained from http://msdn.microsoft.com/en-us/library/ms724385 + // Obtained from https://msdn.microsoft.com/en-us/library/ms724385 SM_TABLETPC = 86; // Detects XP Tablet Edition SM_MEDIACENTER = 87; // Detects XP Media Center Edition SM_STARTER = 88; // Detects XP Starter Edition @@ -363,19 +440,20 @@ interface // These constants are required when examining the // TSystemInfo.wProcessorArchitecture member. - // Only constants marked * are defined in the MS 2008 SDK - PROCESSOR_ARCHITECTURE_UNKNOWN = $FFFF; // Unknown architecture. + // Only constants marked ** are defined in MS docs at 2022-12-31 + PROCESSOR_ARCHITECTURE_UNKNOWN = $FFFF; // Unknown architecture * PROCESSOR_ARCHITECTURE_INTEL = 0; // x86 * PROCESSOR_ARCHITECTURE_MIPS = 1; // MIPS architecture PROCESSOR_ARCHITECTURE_ALPHA = 2; // Alpha architecture PROCESSOR_ARCHITECTURE_PPC = 3; // PPC architecture PROCESSOR_ARCHITECTURE_SHX = 4; // SHX architecture - PROCESSOR_ARCHITECTURE_ARM = 5; // ARM architecture - PROCESSOR_ARCHITECTURE_IA64 = 6; // Intel Itanium Processor Family * + PROCESSOR_ARCHITECTURE_ARM = 5; // ARM architecture * + PROCESSOR_ARCHITECTURE_IA64 = 6; // Intel Itanium based * PROCESSOR_ARCHITECTURE_ALPHA64 = 7; // Alpha64 architecture PROCESSOR_ARCHITECTURE_MSIL = 8; // MSIL architecture PROCESSOR_ARCHITECTURE_AMD64 = 9; // x64 (AMD or Intel) * PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 = 10; // IA32 on Win64 architecture + PROCESSOR_ARCHITECTURE_ARM64 = 12; // ARM64 architecture * // These constants are provided in case the obsolete // TSystemInfo.dwProcessorType needs to be used. @@ -444,9 +522,12 @@ interface osWinSvr2012R2, // Windows Server 2012 R2 osWin10, // Windows 10 osWin10Svr, // Windows 2016 Server - osWinSvr2019 // Windows 2019 Server + osWinSvr2019, // Windows 2019 Server + osWin11, // Windows 11 + osWinSvr2022, // Windows 2022 Server + osWinServer // Windows Server (between Server 2019 & 2022) ); - + type /// <summary>Enumeration identifying processor architecture.</summary> TPJProcessorArchitecture = ( @@ -465,6 +546,17 @@ interface bmSafeModeNetwork // Booted in safe node with networking ); +type + // Various Windows 10 & 11 release versions + TPJWin10PlusVersion = ( + win10plusNA, + win10plusUnknown, + win10v1507, win10v1511, win10v1607, win10v1703, win10v1709, win10v1803, + win10v1809, win10v1903, win10v1909, win10v2004, win10v20H2, win10v21H1, + win10v21H2, win10v22H2, + win11v21H2, win11v22H2, win11v23H2, win11v24H2 + ); + type /// <summary>Class of exception raised by code in this unit.</summary> EPJSysInfo = class(Exception); @@ -484,10 +576,13 @@ TPJOSInfo = class(TObject) /// <returns>True if suite is installed, False if not installed or not an /// NT platform OS.</returns> class function CheckSuite(const Suite: Integer): Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} + + /// <summary>Gets product edition from registry for NT4 pre SP6.</remarks> + class function NTEditionFromReg: string; - /// <summary>Gets product edition from registry.</summary> - /// <remarks>Needed to get edition for NT4 pre SP6.</remarks> - class function EditionFromReg: string; + /// <summary>Gets edition ID from registry.</summary> + class function EditionIDFromReg: string; /// <summary>Checks registry to see if NT4 Service Pack 6a is installed. /// </summary> @@ -509,6 +604,18 @@ TPJOSInfo = class(TObject) class function IsReallyWindowsVersionOrGreater(MajorVersion, MinorVersion, ServicePackMajor: Word): Boolean; + /// <summary>Checks if the operating system is Windows 10 or later, with a + /// version identifier the same or later than the given version identifier. + /// </summary> + /// <remarks> + /// <para>WARNING: Windows 11 versions are always considered to be later + /// Windows 10 versions, even if the Windows 10 version was released after + /// the Windows 11 version.</para> + /// <para><c>AVersion</c> must not be one of <c>win10plusNA</c> or + /// <c>win10plusUnknown</c>.</para> + class function IsWindows10PlusVersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; + public /// <summary>Checks if the OS can be "spoofed" by specifying a @@ -522,14 +629,17 @@ TPJOSInfo = class(TObject) /// <summary>Checks if the OS is on the Windows 9x platform.</summary> class function IsWin9x: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Checks if the OS is on the Windows NT platform.</summary> class function IsWinNT: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Checks if the program is hosted on Win32s.</summary> /// <remarks>This is unlikely to ever return True since Delphi does not run /// on Win32s.</remarks> class function IsWin32s: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Checks if a 32 bit program is running under WOW64 on a 64 bit /// operating system.</summary> @@ -542,17 +652,21 @@ TPJOSInfo = class(TObject) /// <summary>Checks if Windows Media Center is installed.</summary> class function IsMediaCenter: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Checks if the program is running on a tablet PC OS.</summary> class function IsTabletPC: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Checks if the program is running under Windows Terminal Server /// as a client session.</summary> class function IsRemoteSession: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Checks of the host operating system has pen extensions /// installed.</summary> class function HasPenExtensions: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Returns the host OS platform identifier.</summary> class function Platform: TPJOSPlatform; @@ -594,11 +708,13 @@ TPJOSInfo = class(TObject) /// <remarks>0 is returned in no service pack is installed, if the host OS /// is not on the NT platform.</remarks> class function ServicePackMajor: Integer; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Returns the minor version number of any NT platform service /// pack.</summary> - /// <remarks>Invalid is ServicePackMinor returns 0.</remarks> + /// <remarks>Invalid if ServicePackMajor returns 0.</remarks> class function ServicePackMinor: Integer; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Returns the product edition for an NT platform OS.</summary> /// <remarks>The empty string is returned if the OS is not on the NT @@ -611,6 +727,9 @@ TPJOSInfo = class(TObject) /// <summary>Returns the Windows product ID of the host OS.</summary> class function ProductID: string; + /// <summary>Returns the digital product ID of the host OS.</summary> + class function DigitalProductID: TBytes; + /// <summary>Organisation to which Windows is registered, if any.</summary> class function RegisteredOrganisation: string; @@ -746,6 +865,46 @@ TPJOSInfo = class(TObject) class function IsReallyWindows10OrGreater: Boolean; {$IFDEF INLINEMETHODS}inline;{$ENDIF} + /// <summary>Returns an identifier representing a Windows 10 or 11 + /// version.</summary> + /// <remarks>If the OS is earlier than Windows 10 then <c>win10plusNA</c> + /// is returned. If the OS is Windows 10 or later but is a dev, beta etc. + /// build whose version can't be detected then <c>win10plusUnknown</c> is + /// returned.</remarks> + class function Windows10PlusVersion: TPJWin10PlusVersion; + + /// <summary>Returns the version name of a the current operating system, if + /// it is Windows 10 or later.</summary> + /// <remarks> + /// <para>NOTE: some Windows 10 and 11 versions have the same string. + /// </para> + /// <para>If the OS is earlier than Windows 10 then an empty string is + /// returned. If the OS is Windows 10 or later but is a dev, beta etc. + /// build whose version can't be detected then 'Unknown' is returned. + /// </para> + /// </remarks> + class function Windows10PlusVersionName: string; + + /// <summary>Checks if the operating system is Windows 10 or later, with a + /// version identifier the same or later than <c>AVersion</c>. + /// </summary> + /// <remarks><c>AVersion</c> must be a valid Windows 10 version + /// identifier, with a name that begins with <c>win10v</c>.</remarks> + /// <exception><c>EPJSysInfo</c> raised if <c>AVersion</c> is not a valid + /// Windows 10 version identifier.</exception> + class function IsWindows10VersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; + + /// <summary>Checks if the operating system is Windows 11 or later, with a + /// version identifier the same or later than <c>AVersion</c>. + /// </summary> + /// <remarks><c>AVersion</c> must be a valid Windows 11 version + /// identifier, with a name that begins with <c>win11v</c>.</remarks> + /// <exception><c>EPJSysInfo</c> raised if <c>AVersion</c> is not a valid + /// Windows 11 version identifier.</exception> + class function IsWindows11VersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; + /// <summary>Checks if the OS is a server version.</summary> /// <remarks> /// <para>For Windows 2000 and later the result always relates to the @@ -755,6 +914,21 @@ TPJOSInfo = class(TObject) /// <para>WARNING: For Windows 10 this method is likely to succeed only if /// the application is correctly manifested.</para> class function IsWindowsServer: Boolean; + + /// <summary>Returns any revision number for the OS.</summary> + /// <remarks> + /// <para>If the OS does not provide any revision information then zero is + /// returned.</para> + /// <para>This value is read fromt he registry therefore it is possible + /// that this value could be spoofed.</para> + /// </remarks> + class function RevisionNumber: Integer; + + /// <summary>Returns the repository branch from which the OS release was] + /// built.</summary> + /// <remarks>Returns the empty string if no build branch information is + /// available.</remarks> + class function BuildBranch: string; end; type @@ -803,9 +977,11 @@ TPJComputerInfo = class(TObject) /// <summary>Checks if the host computer has a 64 bit processor.</summary> class function Is64Bit: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Checks if a network is present on host computer.</summary> class function IsNetworkPresent: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// <summary>Returns the OS mode used when host computer was last booted. /// </summary> @@ -818,7 +994,7 @@ TPJComputerInfo = class(TObject) /// <para>WARNING: True is also returned when running in Windows 9x /// compatibility mode on a Windows NT platform system, regardless of /// whether the user has admin privileges or not.</para> - /// <para>Based on code at http://edn.embarcadero.com/article/26752</para> + /// <para>Based on a former Embarcadero article.</para> /// </remarks> class function IsAdmin: Boolean; @@ -830,7 +1006,7 @@ TPJComputerInfo = class(TObject) /// earlier compatibility mode on Windows Vista or later, regardless of /// whether UAC is enabled or not.</para> /// <para>Based on code on Stack Overflow, answer by norgepaul, at - /// http://tinyurl.com/avlztmg</para> + /// https://tinyurl.com/avlztmg</para> /// </remarks> class function IsUACActive: Boolean; @@ -935,6 +1111,8 @@ TPJSystemFolders = class(TObject) // Description of any OS service pack. Win32CSDVersionEx: string = ''; + // OS Revision number. Zero if revision number not available. + Win32RevisionNumber: Integer = 0; // Flag that indicates if extended version information is available. Win32HaveExInfo: Boolean = False; // Major version number of the latest Service Pack installed on the system. If @@ -978,6 +1156,7 @@ implementation sUnknownProduct = 'Unrecognised operating system product'; sBadRegType = 'Unsupported registry type'; sBadRegIntType = 'Integer value expected in registry'; + sBadRegBinType = 'Binary value expected in registry'; sBadProcHandle = 'Bad process handle'; @@ -988,13 +1167,14 @@ implementation UInt64 = Int64; {$ENDIF} - const // Map of product codes per GetProductInfo API to product names + // Names are not available for all PRODUCT_xxx values. // ** Laurent Pierre supplied original code on which this map is based // It has been modified and extended using MSDN documentation at - // http://msdn.microsoft.com/en-us/library/ms724358 - cProductMap: array[1..87] of record + // https://msdn.microsoft.com/en-us/library/ms724358 and + // https://tinyurl.com/5684558v (learn.microsoft.com) + cProductMap: array[1..107] of record Id: Cardinal; // product ID Name: string; // product name end = ( @@ -1007,23 +1187,19 @@ implementation (Id: PRODUCT_CLUSTER_SERVER_V; Name: 'Server Hyper Core V';), (Id: PRODUCT_CORE; - Name: 'Core / Home';), - (Id: PRODUCT_CORE_N; - Name: 'Core N or Home N';), + Name: 'Home (Core)';), (Id: PRODUCT_CORE_COUNTRYSPECIFIC; - Name: 'Core / Home China';), + Name: 'Home (Core) China';), + (Id: PRODUCT_CORE_N; + Name: 'Home (Core) N';), (Id: PRODUCT_CORE_SINGLELANGUAGE; - Name: 'Core / Home Single Language';), - (Id: PRODUCT_MOBILE_CORE; - Name: 'Mobile'), - (Id: PRODUCT_MOBILE_ENTERPRISE; - Name: 'Mobile Enterprise'), - (Id: PRODUCT_EDUCATION; - Name: 'Education'), - (Id: PRODUCT_EDUCATION_N; - Name: 'Education N'), + Name: 'Home (Core) Single Language';), (Id: PRODUCT_DATACENTER_EVALUATION_SERVER; Name: 'Server Datacenter (evaluation installation)';), + (Id: PRODUCT_DATACENTER_A_SERVER_CORE; + Name: 'Server Datacenter, Semi-Annual Channel (core installation)';), + (Id: PRODUCT_STANDARD_A_SERVER_CORE; + Name: 'Server Standard, Semi-Annual Channel (core installation)';), (Id: PRODUCT_DATACENTER_SERVER; Name: 'Server Datacenter (full installation)';), (Id: PRODUCT_DATACENTER_SERVER_CORE; @@ -1032,16 +1208,28 @@ implementation Name: 'Server Datacenter without Hyper-V (core installation)';), (Id: PRODUCT_DATACENTER_SERVER_V; Name: 'Server Datacenter without Hyper-V (full installation)';), + (Id: PRODUCT_EDUCATION; + Name: 'Education'), + (Id: PRODUCT_EDUCATION_N; + Name: 'Education N'), (Id: PRODUCT_ENTERPRISE; Name: 'Enterprise';), (Id: PRODUCT_ENTERPRISE_E; Name: 'Enterprise E';), - (Id: PRODUCT_ENTERPRISE_N_EVALUATION; - Name: 'Enterprise N (evaluation installation)';), - (Id: PRODUCT_ENTERPRISE_N; - Name: 'Enterprise N';), (Id: PRODUCT_ENTERPRISE_EVALUATION; Name: 'Server Enterprise (evaluation installation)';), + (Id: PRODUCT_ENTERPRISE_N; + Name: 'Enterprise N';), + (Id: PRODUCT_ENTERPRISE_N_EVALUATION; + Name: 'Enterprise N (evaluation installation)';), + (Id: PRODUCT_ENTERPRISE_S; + Name: 'Enterprise 2015 LTSB';), + (Id: PRODUCT_ENTERPRISE_S_EVALUATION; + Name: 'Enterprise 2015 LTSB Evaluation';), + (Id: PRODUCT_ENTERPRISE_S_N; + Name: 'Enterprise 2015 LTSB N';), + (Id: PRODUCT_ENTERPRISE_S_N_EVALUATION; + Name: 'Enterprise 2015 LTSB N Evaluation';), (Id: PRODUCT_ENTERPRISE_SERVER; Name: 'Server Enterprise (full installation)';), (Id: PRODUCT_ENTERPRISE_SERVER_CORE; @@ -1052,14 +1240,14 @@ implementation Name: 'Server Enterprise for Itanium-based Systems';), (Id: PRODUCT_ENTERPRISE_SERVER_V; Name: 'Server Enterprise without Hyper-V (full installation)';), - (Id: PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT; - Name: 'Windows Essential Server Solution Management'), (Id: PRODUCT_ESSENTIALBUSINESS_SERVER_ADDL; Name: 'Windows Essential Server Solution Additional'), - (Id: PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC; - Name: 'Windows Essential Server Solution Management SVC'), (Id: PRODUCT_ESSENTIALBUSINESS_SERVER_ADDLSVC; Name: 'Windows Essential Server Solution Additional SVC'), + (Id: PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT; + Name: 'Windows Essential Server Solution Management'), + (Id: PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC; + Name: 'Windows Essential Server Solution Management SVC'), (Id: PRODUCT_HOME_BASIC; Name: 'Home Basic';), (Id: PRODUCT_HOME_BASIC_E; @@ -1077,25 +1265,43 @@ implementation (Id: PRODUCT_HOME_SERVER; Name: 'Home Storage Server';), (Id: PRODUCT_HYPERV; - Name: 'Hyper-V Server'), + Name: 'Hyper-V Server';), + (Id: PRODUCT_IOTENTERPRISE; + Name: 'IoT Enterprise';), + (Id: PRODUCT_IOTENTERPRISE_S; + Name: 'IoT Enterprise LTSC'), + (Id: PRODUCT_IOTUAP; + Name: 'IoT Core';), + (Id: PRODUCT_IOTUAPCOMMERCIAL; + Name: 'IoT Core Commercial';), (Id: PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT; Name: 'Essential Business Server Management Server';), (Id: PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING; Name: 'Essential Business Server Messaging Server';), (Id: PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY; Name: 'Essential Business Server Security Server';), - (Id: PRODUCT_MULTIPOINT_STANDARD_SERVER; - Name: 'MultiPoint Server Standard (full installation)';), + (Id: PRODUCT_MOBILE_CORE; + Name: 'Mobile'), + (Id: PRODUCT_MOBILE_ENTERPRISE; + Name: 'Mobile Enterprise'), (Id: PRODUCT_MULTIPOINT_PREMIUM_SERVER; Name: 'MultiPoint Server Premium (full installation)';), + (Id: PRODUCT_MULTIPOINT_STANDARD_SERVER; + Name: 'MultiPoint Server Standard (full installation)';), + (Id: PRODUCT_PRO_WORKSTATION; + Name: 'Pro for Workstations';), + (Id: PRODUCT_PRO_WORKSTATION_N; + Name: 'Pro for Workstations N';), (Id: PRODUCT_PROFESSIONAL; - Name: 'Professional';), + Name: 'Pro (Professional)';), (Id: PRODUCT_PROFESSIONAL_E; Name: 'Professional E';), (Id: PRODUCT_PROFESSIONAL_N; - Name: 'Professional N';), + Name: 'Pro (Professional) N';), (Id: PRODUCT_PROFESSIONAL_WMC; Name: 'Professional with Media Center';), + (Id: PRODUCT_SB_SOLUTION_SERVER; + Name: 'Small Business Server Essentials';), (Id: PRODUCT_SB_SOLUTION_SERVER_EM; Name: 'Server For SB Solutions EM';), (Id: PRODUCT_SERVER_FOR_SB_SOLUTIONS; @@ -1105,11 +1311,9 @@ implementation (Id: PRODUCT_SERVER_FOR_SMALLBUSINESS; Name: 'Server for Essential Server Solutions';), (Id: PRODUCT_SERVER_FOR_SMALLBUSINESS_V; - Name: 'Server 2008 without Hyper-V for Essential Server Solutions';), + Name: 'Server without Hyper-V for Essential Server Solutions';), (Id: PRODUCT_SERVER_FOUNDATION; Name: 'Server Foundation';), - (Id: PRODUCT_SB_SOLUTION_SERVER; - Name: 'Small Business Server Essentials';), (Id: PRODUCT_SMALLBUSINESS_SERVER; Name: 'Small Business Server';), (Id: PRODUCT_SMALLBUSINESS_SERVER_PREMIUM; @@ -1127,7 +1331,7 @@ implementation (Id: PRODUCT_STANDARD_SERVER_CORE_V; Name: 'Server Standard without Hyper-V (core installation)';), (Id: PRODUCT_STANDARD_SERVER_V; - Name: 'Server Standard without Hyper-V (full installation)';), + Name: 'Server Standard without Hyper-V';), (Id: PRODUCT_STANDARD_SERVER_SOLUTIONS; Name: 'Server Solutions Premium';), (Id: PRODUCT_STANDARD_SERVER_SOLUTIONS_CORE; @@ -1158,18 +1362,34 @@ implementation Name: 'Storage Server Workgroup';), (Id: PRODUCT_STORAGE_WORKGROUP_SERVER_CORE; Name: 'Storage Server Workgroup (core installation)';), - (Id: PRODUCT_UNDEFINED; - Name: 'An unknown product';), (Id: PRODUCT_ULTIMATE; Name: 'Ultimate';), (Id: PRODUCT_ULTIMATE_E; Name: 'Ultimate E';), (Id: PRODUCT_ULTIMATE_N; Name: 'Ultimate N';), + (Id: PRODUCT_UNDEFINED; + Name: 'An unknown product';), (Id: PRODUCT_WEB_SERVER; Name: 'Web Server (full installation)';), (Id: PRODUCT_WEB_SERVER_CORE; Name: 'Web Server (core installation)';), + (Id: PRODUCT_CORE_ARM; + Name: 'Windows RT';), + (Id: PRODUCT_DATACENTER_NANO_SERVER; + Name: 'Windows Server Datacenter Edition (Nano Server installation)';), + (Id: PRODUCT_STANDARD_NANO_SERVER; + Name: 'Windows Server Standard Edition (Nano Server installation)';), + (Id: PRODUCT_DATACENTER_WS_SERVER_CORE; + Name: 'Windows Server Datacenter Edition (Server Core installation)';), + (Id: PRODUCT_STANDARD_WS_SERVER_CORE; + Name: 'Windows Server Standard Edition (Server Core installation)';), + (Id: PRODUCT_PRO_FOR_EDUCATION; + Name: 'Windows 10 Pro Education';), + (Id: PRODUCT_SERVERRDSH; + Name: 'Windows 10 Enterprise for Virtual Desktops';), + (Id: PRODUCT_DATACENTER_SERVER_AZURE_EDITION; + Name: 'Windows Server Datacenter: Azure Edition';), (Id: Cardinal(PRODUCT_UNLICENSED); Name: 'Unlicensed product';) ); @@ -1182,64 +1402,446 @@ implementation 'Software\Microsoft\Windows NT\CurrentVersion' ); +type + // Record used to map a build number to a release name + // Generally used in arrays + TBuildNameMap = record + Build: Integer; + LoRev: Integer; + HiRev: Integer; + Name: string; + Version: Word; + end; + + TWin10PlusVersionSet = set of TPJWin10PlusVersion; + const - // Known windows build numbers. - // Sources: - // https://en.wikipedia.org/wiki/Windows_NT - // https://en.wikipedia.org/wiki/Windows_10_version_history - // https://en.wikipedia.org/wiki/Windows_Server_2019 - // https://en.wikipedia.org/wiki/Windows_Server_2016 - // https://en.wikipedia.org/wiki/Windows_Server_2016 - // https://tinyurl.com/y8tfadm2 - - // for Vista and Win 7 we have to add service pack number to these values to - // get actual build number - - WinVistaBaseBuild = 6000; - Win7BaseBuild = 7600; - - // for Win 8 onwards we just use the build numbers as is - - Win8Build = 9200; // Build number used for all Win 8/Svr 2012 - Win8Point1Build = 9600; // Build number used for all Win 8.1/Svr 2012 R2 - - Win10TH1Build = 10240; // Windows 10 TH1 - version 1507 (1st release) - Win10TH2Build = 10586; // Windows 10 TH2 - version 1511 - Win10RS1Build = 14393; // Windows 10 RS1 - version 1607 - Win10RS2Build = 15063; // Windows 10 RS2 - version 1703 - Win10RS3Build = 16299; // Windows 10 RS3 - version 1709 - Win10RS4Build = 17134; // Windows 10 RS4 - version 1803 - Win10RS5Build = 17763; // Windows 10 RS5 - version 1809 - Win1019H1Build = 18362; // Windows 10 19H1 - version 1903 - Win1019H2Build = 18363; // Windows 10 19H2 - version 1909 - Win1020H1Build = 19041; // Windows 10 20H2 - version 2004 - - Win2016TP1Build = 9841; // Win 2016 Server Technical Preview 1 - Win2016TP2Build = 10074; // Win 2016 Server Technical Preview 2 - Win2016TP3Build = 10514; // Win 2016 Server Technical Preview 3 - Win2016TP4Build = 10586; // Win 2016 Server Technical Preview 4 - Win2016TP5Build = 14300; // Win 2016 Server Technical Preview 5 - Win2016RTMBuild = 14393; // Win 2016 Server Release To Manufacturing - Win2016v1709Build = 16299; // Win Server 2016 version 1709 - Win2016v1803Build = 17134; // Win Server 2016 version 1803 - - Win2019IP180320Build = 17623; // Win Server 2019 Insider Preview Build 17623 - Win2019IP180324Build = 17627; // Win Server 2019 Insider Preview Build 17627 - Win2019IP180515Build = 17666; // Win Server 2019 Insider Preview Build 17666 - Win2019IP180619Build = 17692; // Win Server 2019 Insider Preview Build 17692 - Win2019IP180710Build = 17709; // Win Server 2019 Insider Preview Build 17709 - Win2019IP180716Build = 17713; // Win Server 2019 Insider Preview Build 17713 - Win2019IP180731Build = 17723; // Win Server 2019 Insider Preview Build 17723 - Win2019IP180814Build = 17733; // Win Server 2019 Insider Preview Build 17733 - Win2019IP180821Build = 17738; // Win Server 2019 Insider Preview Build 17738 - Win2019IP180828Build = 17744; // Win Server 2019 Insider Preview Build 17744 - Win2019v1809Build = 17763; // Win Server 2019 version 1809 - Win2019v1903Build = 18362; // Win Server 2019 version 1903 - Win2019v1909Build = 18363; // Win Server 2019 version 1909 - - // Last build number of Windows 2016 Server - after this build number are - // Windows 2019 Server - Win2016LastBuild = Win2016v1803Build; + { + Known windows build numbers. + Sources: + https://en.wikipedia.org/wiki/List_of_Microsoft_Windows_versions + https://en.wikipedia.org/wiki/Windows_NT + https://en.wikipedia.org/wiki/Windows_10_version_history + https://en.wikipedia.org/wiki/Windows_11_version_history + https://blogs.windows.com/windows-insider/tag/windows-insider-program/ + https://en.wikipedia.org/wiki/Windows_Server + https://en.wikipedia.org/wiki/Windows_Server_2019 + https://en.wikipedia.org/wiki/Windows_Server_2016 + https://en.wikipedia.org/wiki/Windows_Server_2022 + https://tinyurl.com/y8tfadm2 (MS Windows Server release information) + https://docs.microsoft.com/en-us/lifecycle/products/windows-server-2022 + https://tinyurl.com/yj5e72jt (MS Win 10 release info) + https://tinyurl.com/kd3weeu7 (MS Server release info) + + Note: + For Vista and Win 7 we have to add service pack number to these values to + get actual build number. For Win 8 onwards we just use the build numbers + as is. + + References: + [^1] MS community blog post https://tinyurl.com/3c8e3hsc + [^2] https://en.wikipedia.org/wiki/Windows_11_version_history + } + + { + End of support (EOS) information for Windows Vista to Windows 8.1 + + Version | Mainstream EOS | Extended EOS + --------|----------------|------------- + Vista | 2012-04-10 | 2017-04-11 + 7 | 2015-01-13 | 2020-01-14 + 8 | N/a | 2016-01-12 + 8.1 | 2018-01-09 | 2023-01-10 + + See below for Windows 10 & 11 end of support information. + } + + + // Windows Vista ------------------------------------------------------------- + WinVista_Base_Build = 6000; + + // Windows 7 ----------------------------------------------------------------- + Win7_Base_Build = 7600; + + // Windows 8 ----------------------------------------------------------------- + Win8_Build = 9200; // Build number used for all Win 8/Svr 2012 + Win8Point1_Build = 9600; // Build number used for all Win 8.1/Svr 2012 R2 + + // Windows 10 ---------------------------------------------------------------- + + // Version 1507 preview builds + // Preview builds with major/minor version number 6.4 + // Expired by 2015-04-30 [^1]: + // 9841, 9860, 9879 + // Preview builds with major/minor version number 10.0 + // Expired by 2015-10-15 [^1]: + // 9926, 10041, 10049, 10061, 10074, 10122, 10130, 10158, 10159, 10162, + // 10166 + + // Version 1511 preview builds + // Expired by 2016-07-30 [^1]: + // 10525, 10532, 10547, 10565, 10576 + + // Version 1607 previews + Win10_1607_Preview_Builds: array[0..5] of Integer = ( + // Expired 2016-07-30 [^1]: + // 11082, 11099 + // Expired 2016-08-01 [^1]: + // 11102, 14251, 14257, 14267, 14271, 14279, 14291, 14295, 14316, 14328, + // 14332, 14342, 14352, 14361 + // Expired 2016-10-15 [^1]: + // 14366, 14367, 14371, 14372, + 14376, 14379, 14383, 14385, // unknown expiry date [^1] + 14388, 14390 // permanently activated [^1] + ); + + // Version 1703 previews + Win10_1703_Preview_Builds: array[0..26] of Integer = ( + 14901, 14905, 14915, 14926, 14931, 14936, 14942, 14946, 14951, 14955, + 14959, 14965, 14971, 14986, 15002, 15007, 15014, 15019, 15025, 15031, + 15042, 15046, 15048, 15055, 15058, 15060, 15061 + ); + + // Version 1709 previews + Win10_1709_Preview_Builds: array[0..23] of Integer = ( + 16170, 16176, 16179, 16184, 16188, 16193, 16199, 16212, 16215, 16226, + 16232, 16237, 16241, 16251, 16257, 16273, 16275, 16278, 16281, 16288, + 16291, 16294, 16296, 16299 {rev 0 only} + ); + + // Version 1803 previews + Win10_1803_Preview_Builds: array[0..21] of Integer = ( + 16353, 16362, 17004, 17017, 17025, 17035, 17040, 17046, 17063, 17074, + 17083, 17093, 17101, 17107, 17110, 17112, 17115, 17120, 17123, 17127, + 17128, 17133 + ); + + // Version 1809 previews + Win10_1809_Preview_Builds: array[0..33] of Integer = ( + 17604, 17618, 17623, 17627, 17634, 17639, 17643, 17650, 17655, 17661, + 17666, 17672, 17677, 17682, 17686, 17692, 17704, 17711, 17713, 17723, + 17728, 17730, 17733, 17735, 17738, 17741, 17744, 17746, 17751, 17754, + 17755, 17758, 17760, 17763 {rev 0 only} + ); + + // Version 1903 previews + Win10_1903_Preview_Builds: array[0..30] of Integer = ( + 18204, 18214, 18219, 18234, 18237, 18242, 18247, 18252, 18262, 18267, + 18272, 18277, 18282, 18290, 18298, 18305, 18309, 18312, 18317, 18323, + 18329, 18334, 18342, 18343, 18346, 18348, 18351, 18353, 18356, 18358, + 18361 + ); + + // Single build number used for 3 purposes: + // 1903 preview - revs 0, 30, 53, 86, 113 + // 1903 release - revs 116..1256 + // 1909 preview - revs 10000, 10005, 10006, 10012, 10014, 10015, + // 10019, 10022, 10024 + Win10_19XX_Shared_Build = 18362; + + // Version 1909 previews used build 18362 rev 10000 and later (see above) + + // Version 2004 previews + Win10_2004_Preview_Builds: array[0..43] of Integer = ( + 18836, 18841, 18845, 18850, 18855, 18860, 18865, 18875, 18885, 18890, + 18894, 18895, 18898, 18908, 18912, 18917, 18922, 18932, 18936, 18941, + 18945, 18950, 18956, 18963, 18965, 18970, 18975, 18980, 18985, 18990, + 18995, 18999, 19002, 19008, 19013, 19018, 19023, 19025, 19028, 19030, + 19033, 19035, 19037, + 19041 {revs 0, 21, 84, 113, 153, 172, 173, 207, 208 only} + ); + + // Version 20H2 previews: all used 19042, also used for release + Win10_20H2_Preview_Builds: array[0..0] of Integer = ( + 19042 + ); + + { + End of support information for Windows 10 versions (as of 2024-10-01). + GAC = General Availablity Channel. + LTSC = Long Term Support Channel. + + Version | GAC | LTSC + --------|------------|------------ + 1507 | ended | 2025-10-14 + 1511 | ended | N/a + 1607 | ended | 2026-10-13 + 1703 | ended | N/a + 1709 | ended | N/a + 1803 | ended | N/a + 1809 | ended | 2029-01-09 + 1903 | ended | N/a + 1909 | ended | N/a + 2004 | ended | N/a + 20H2 | ended | N/a + 21H1 | ended | N/a + 21H2 | ended | 2032-01-13 + 22H2 | 2025-10-14 | N/a + } + + // Win 10 release build numbers + Win10_1507_Build = 10240; + Win10_1511_Build = 10586; + Win10_1607_Build = 14393; + Win10_1703_Build = 15063; + Win10_1709_Build = 16299; + Win10_1803_Build = 17134; + Win10_1809_Build = 17763; + Win10_1903_Build = Win10_19XX_Shared_Build; + Win10_1909_Build = 18363; + Win10_2004_Build = 19041; + Win10_20H2_Build = 19042; + Win10_21H1_Build = 19043; // See **REF3** End of service @ rev 2364 + Win10_21H2_Build = 19044; // See **REF4** + Win10_22H2_Build = 19045; // See **REF5** + + // Map of Win 10 builds from 1st release (version 1507) to version 20H2 + // Later Win 10 releases have special handling and aren't in the build map + // + // NOTE: The following versions that are still being maintained per the above + // table have HiRev = MaxInt while the unsupported versions have HiRev set to + // the final build number. + Win10_BuildMap: array[0..10] of TBuildNameMap = ( + (Build: Win10_1507_Build; LoRev: 16484; HiRev: MaxInt; + Name: 'Version 1507'; Version: Ord(win10v1507)), + (Build: Win10_1511_Build; LoRev: 0; HiRev: 1540; + Name: 'Version 1511: November Update'; Version: Ord(win10v1511)), + (Build: Win10_1607_Build; LoRev: 0; HiRev: MaxInt; + Name: 'Version 1607: Anniversary Update'; Version: Ord(win10v1607)), + (Build: Win10_1703_Build; LoRev: 0; HiRev: 2679; + Name: 'Version 1703: Creators Update'; Version: Ord(win10v1703)), + (Build: Win10_1709_Build; LoRev: 15; HiRev: 2166; + Name: 'Version 1709: Fall Creators Update'; Version: Ord(win10v1709)), + (Build: Win10_1803_Build; LoRev: 1; HiRev: 2208; + Name: 'Version 1803: April 2018 Update'; Version: Ord(win10v1803)), + (Build: Win10_1809_Build; LoRev: 1; HiRev: MaxInt; + Name: 'Version 1809: October 2018 Update'; Version: Ord(win10v1809)), + (Build: Win10_1903_Build; LoRev: 116; HiRev: 1256; + Name: 'Version 1903: May 2019 Update'; Version: Ord(win10v1903)), + (Build: Win10_1909_Build; LoRev: 327; HiRev: 2274; + Name: 'Version 1909: November 2019 Update'; Version: Ord(win10v1909)), + (Build: Win10_2004_Build; LoRev: 264; HiRev: 1415; + Name: 'Version 2004: May 2020 Update'; Version: Ord(win10v2004)), + (Build: Win10_20H2_Build; LoRev: 572; HiRev: 2965; + Name: 'Version 20H2: October 2020 Update'; Version: Ord(win10v20H2)) + ); + + // Set of Windows 10 version identifiers + Win10_Versions: TWin10PlusVersionSet = [ + win10v1507, win10v1511, win10v1607, win10v1703, win10v1709, win10v1803, + win10v1809, win10v1903, win10v1909, win10v2004, win10v20H2, win10v21H1, + win10v21H2, win10v22H2 + ]; + + // Windows 10 slow ring, fast ring and skip-ahead channels were all expired + // well before 2022-12-31 and are not detected. (In fact there was never any + // detection of the slow ring and skip-ahead channels). + + // Windows 11 ---------------------------------------------------------------- + + // NOTE: All releases of Windows 11 report version 10.0 + + { + End of support (EOS) information for Windows 11 versions (as of 2024-10-01). + + Version | Home, Pro | Education, + | etc EOS | Enterprise + | | etc EOS + --------|------------|------------ + 21H2 | ENDED | 2024-10-08 + 22H2 | 2024-10-08 | 2025-10-14 + 23H2 | 2025-11-11 | 2026-11-10 + 24H2 | 2026-10-13 | 2027-10-12 + } + + // 1st build released branded as Windows 11 + // Insider version, Dev channel, v10.0.21996.1 + Win11_Dev_Build = 21996; + + // Windows 11 version 21H2 - see **REF6** in implementation for details + Win11_21H2_Build = 22000; + + // Windows 11 version 22H2 + // + // Build 22621 was the original beta build. Same build used for releases and + // various other channels. + // See **REF1** in implementation + Win11_22H2_Build = 22621; + + // Windows 11 version 22H3 + // See **REF10** in implementation + Win11_23H2_Build = 22631; + + // Windows 11 version 22H4 + // See **REF11** in implementation + Win11_24H2_Build = 26100; + + // "Preview Builds of October 2022 component update in Beta Channel" + // See **REF2** in implementation + Win11_Oct22Component_BetaChannel_Build = 22622; + + // "Preview Builds of February 2023 component update in Beta Channel" + // See **REF7** in implementation + Win11_Feb23Component_BetaChannel_Build = 22623; + + // "Preview builds of May 2023 component update in Beta Channel" + // See **REF8** in implementation + Win11_May23Component_BetaChannel_Build = 22624; + + // "Preview builds of future component update in Beta Channel" + // See **REF9** in implementation + Win11_FutureComponent_BetaChannel_Build = 22635; + + // "Preview builds of future component update in Dev Channel" + // See **REF12** in implementation + Win11_FutureComponent_DevChannel_Build = 26120; + + // Windows 11 Dev channel releases with version string "Dev" [^2] + // pre Win 11 release (expired 2021/10/31): + // 22449, 22454, 22458, 22463, + // pre Win 11 release (expired 2022/09/15): + // 22468, + // post Win 11 release, pre Win 11 22H2 beta release (expired 2022/09/15): + // 22471, 22478, 22483, 22489, 22494, 22499, 22504, 22509, 22518, 22523, + // 22526, 22533, 22538, 22543, 22557, 22563, + + // Windows 11 Dev channel releases with version string "22H2" [^2] + // pre Win 11 22H2 beta release (expired 2022/09/15): + // 22567, 22572, 22579 + // post Win 11 22H2 beta release (expired 2022/09/15): + // 25115, 25120, 25126, 25131, 25136, 25140, 25145, 25151, 25158, 25163, + // 25169, 25174, 25179, + // post Win 11 22H2 beta release (expired 2023/09/15): + // 25182, 25188, 25193, 25197, 25201, 25206, 25211, + // post Win 11 22H2 release, ni_release string (expired 2023/09/15): + // 25217, 25227, 25231, 25236, 25247, 25252, 25262, 25267, 25272, 25276, + // 25281, 25284, 25290, 25295, 25300, 25309, + // post Win 11 22H2 release, ni_prerelease string (expired 2023/09/15): + // 23403, 23419, 23424, 23430, 23435, 23440, 23451, 23466, 23471, 23475, + // 23481, 23486, 23493, 23506, 23511, 23516, 23521, + // post Win 11 22H2 release, ni_prerelease string (expired 2024-09-15): + // 23526, 23531, 23536, 23541, 23545, 23550, 23555, 23560, 23565, 23570, + // 23575, 23580, 23585, 23590, 23595, 23601, 23606, 23612, 23615, 23619, + // 23620 + + // Preview builds of Windows 11 in the Canary Channel with version string + // "22H2" [^2] + // expired 2023-09-15: + // 25314, 25324, 25330, 25336, 25346, 25352, 25357, 25370, + + // Preview builds of Windows 11 in the Canary Channel with version string + // "23H2" [^2] + // Expired 2023-09-15: + // 25375, 25381, 25387, 25393, 25905, 25915, 25921, 25926, + // Expired 2024-09-15: + // 25931, 25936, 25941, 25947, 25951, 25967, 25977, 25982, 25987, 25992, + // 25997, 26002, 26010, 26016, 26020, 26040, 26063, 26200, 26212, 26217, + // 26227, 26231, 26236, 26241, 26244, 26252, 26257, 27686. + + // Windows 11 Dev & Beta channel builds with version string "22H2" [^2] + Win11_22H2_DevAndBetaChannel_Builds: array[0..1] of Integer = ( + // Expired 2022/09/15: + // 22581, 22593, 22598 + // Unknown expiry date: + 22610, 22616 + ); + + // Windows 11 Preview, Dev & Canary channel builds with version "24H2" [^2] + Win11_24H2_DevAndCanaryChannel_Builds: array[0..1] of Integer = ( + // Expired 2024-09-15: + // 26052, 26058, 26080, 26085, + // Unknown expiry date: + 26090 {Dev revs:1,112; Canary revs: 1}, + 26100 {Dev revs:1,268; Canary revs: 1} + ); + + Win11_24H2_CanaryChannel_Builds: array[0..0] of Integer = ( + // expiring 2025-09-15: + 27695 + ); + + Win11_First_Build = Win11_Dev_Build; // First build number of Windows 11 + + // Windows server v10.0 version ---------------------------------------------- + + // These are the Windows server versions that (with one exception) report + // version 10.0. There's always an exception with Windows versioning! + + // Last build numbers of each "major" release before moving on to the next + Win2016_Last_Build = 17134; + Win2019_Last_Build = 18363; + WinServer_Last_Build = 19042; + + // Set of Windows 10 version identifiers + Win11_Versions: TWin10PlusVersionSet = [ + win11v21H2, win11v22H2, win11v23H2, win11v24H2 + ]; + + { + End of support information for all Windows Server versions. + + Version | End date + -----------------------------------|------------ + Windows NT 3.1 | 2000-12-31 + Windows NT 3.5 | 2001-12-31 + Windows NT 3.51 | 2001-12-31 + Windows NT 4.0 | 2004-12-31 + Windows 2000 | 2010-07-13 + Windows Server 2003 | 2015-07-14 + Windows Server 2003 R2 | 2015-07-14 + Windows Server 2008 | 2020-01-14 + Windows Server 2008 R2 | 2020-01-14 + Windows Server 2012 | 2023-10-10 + Windows Server 2012 R2 | 2023-10-10 + Windows Server 2016, version 1607 | 2027-01-12 + Windows Server 2016, version 1709 | 2019-04-09 + Windows Server 2016, version 1803 | 2019-11-12 + Windows Server 2019, version 1809 | 2029-01-09 + Windows Server 2019, version 1903 | 2020-12-08 + Windows Server 2019, version 1909 | 2021-05-11 + Windows Server, version 2004 | 2021-12-14 + Windows Server, version 20H2 | 2022-08-09 + Windows Server 2022, version 21H2 | 2031-10-14 + } + + // Map of Windows server releases that are named straightforwardly + WinServerSimpleBuildMap: array[0..12] of TBuildNameMap = ( + // Windows Server 2016 + (Build: 10074; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 2'; + Version: 0), + (Build: 10514; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 3'; + Version: 0), + (Build: 10586; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 4'; + Version: 0), + (Build: 14300; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 5'; + Version: 0), + (Build: 14393; LoRev: 0; HiRev: MaxInt; Name: 'Version 1607'; Version: 0), + (Build: 16299; LoRev: 0; HiRev: MaxInt; Name: 'Version 1709'; Version: 0), + (Build: Win2016_Last_Build; LoRev: 0; HiRev: MaxInt; Name: 'Version 1803'; + Version: 0), + // Windows Server 2019 + (Build: 17763; LoRev: 0; HiRev: MaxInt; Name: 'Version 1809'; Version: 0), + (Build: 18362; LoRev: 0; HiRev: MaxInt; Name: 'Version 1903'; Version: 0), + (Build: Win2019_Last_Build; LoRev: 0; HiRev: MaxInt; Name: 'Version 1909'; + Version: 0), + // Windows Server (no year number) + (Build: 19041; LoRev: 0; HiRev: MaxInt; Name: 'Version 2004'; Version: 0), + (Build: WinServer_Last_Build; LoRev: 0; HiRev: MaxInt; + Name: 'Version 20H2'; Version: 0), + // Windows Server 2022 + (Build: 20348; LoRev: 0; HiRev: MaxInt; Name: 'Version 21H2'; Version: 0) + ); + + // Windows server releases needing special handling + + // Server 2016 Technical Preview 1: reports version 6.4 instead of 10.0! + Win2016_TP1_Build = 9841; + + // Server 2019 Insider Preview builds: require format strings in names + Win2019_IP_Builds: array[0..9] of Integer = ( + 17623, 17627, 17666, 17692, 17709, 17713, 17723, 17733, 17738, 17744 + ); + type // Function type of the GetNativeSystemInfo and GetSystemInfo functions @@ -1276,6 +1878,7 @@ implementation InternalMinorVersion: LongWord = 0; InternalBuildNumber: Integer = 0; InternalCSDVersion: string = ''; + InternalRevisionNumber: Integer = 0; // Internal variable recording processor architecture information InternalProcessorArchitecture: Word = 0; // Internal variable recording additional update information. @@ -1284,12 +1887,22 @@ implementation // ** At present this variable is only used for Windows 10. InternalExtraUpdateInfo: string = ''; + InternalWin1011Version: TPJWin10PlusVersion = win10plusNA; + // Flag required when opening registry with specified access flags {$IFDEF REGACCESSFLAGS} const KEY_WOW64_64KEY = $0100; // registry access flag not defined in all Delphis {$ENDIF} +// Checks if integer V is in the range of values defined by VLo and VHi, +// inclusive. +function IsInRange(const V, VLo, VHi: Integer): Boolean; +begin + Assert(VLo <= VHi); + Result := (V >= VLo) and (V <= VHi); +end; + // Tests Windows version (major, minor, service pack major & service pack minor) // against the given values using the given comparison condition and return // True if the given version matches the current one or False if not @@ -1337,9 +1950,12 @@ function TestWindowsVersion(wMajorVersion, wMinorVersion, ); end; -// Checks if given build number matches that of the current OS. -// Assumes VerifyVersionInfo & VerSetConditionMask APIs functions are available -function IsBuildNumber(BuildNumber: DWORD): Boolean; +// Checks how the OS build number compares to the given TestBuildNumber +// according to operator Op. +// Op must be one of VER_EQUAL, VER_GREATER, VER_GREATER_EQUAL, VER_LESS or +// VER_LESS_EQUAL. +// Assumes VerifyVersionInfo & VerSetConditionMask APIs functions are available. +function TestBuildNumber(Op, TestBuildNumber: DWORD): Boolean; var OSVI: TOSVersionInfoEx; POSVI: POSVersionInfoEx; @@ -1348,12 +1964,94 @@ function IsBuildNumber(BuildNumber: DWORD): Boolean; Assert(Assigned(VerSetConditionMask) and Assigned(VerifyVersionInfo)); FillChar(OSVI, SizeOf(OSVI), 0); OSVI.dwOSVersionInfoSize := SizeOf(OSVI); - OSVI.dwBuildNumber := BuildNumber; + OSVI.dwBuildNumber := TestBuildNumber; POSVI := @OSVI; - ConditionalMask := VerSetConditionMask(0, VER_BUILDNUMBER, VER_EQUAL); + ConditionalMask := VerSetConditionMask(0, VER_BUILDNUMBER, Op); Result := VerifyVersionInfo(POSVI, VER_BUILDNUMBER, ConditionalMask); end; +// Checks if given build number matches that of the current OS. +// Assumes VerifyVersionInfo & VerSetConditionMask APIs functions are available. +function IsBuildNumber(BuildNumber: DWORD): Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} +begin + Result := TestBuildNumber(VER_EQUAL, BuildNumber); +end; + +// Checks if any of the given build numbers match that of the current OS. +// If current build number is in the list, FoundBN is set to the found build +// number and True is returned. Otherwise False is returned and FoundBN is set +// to zero. +function FindBuildNumberFrom(const BNs: array of Integer; var FoundBN: Integer): + Boolean; +var + I: Integer; +begin + FoundBN := 0; + Result := False; + for I := Low(BNs) to High(BNs) do + begin + if IsBuildNumber(BNs[I]) then + begin + FoundBN := BNs[I]; + Result := True; + Break; + end; + end; +end; + +// Checks if any of the build numbers in the given array match that of the +// current OS AND if the OS revision number is in the specified range. If so +// then the build number that was found then True is returned, and the build +// number and it's associated text are passed back in the FoundBN and FoundExtra +// parameters respectively. Otherwise False is returned, FoundBN is set to 0 and +// FoundExtra is set to ''. +function FindBuildNameAndExtraFrom(const Infos: array of TBuildNameMap; + var FoundBN: Integer; var FoundExtra: string; var FoundVersion: Word): + Boolean; +var + I: Integer; +begin + FoundBN := 0; + FoundExtra := ''; + Result := False; + for I := Low(Infos) to High(Infos) do + begin + if IsBuildNumber(Infos[I].Build) and + IsInRange(InternalRevisionNumber, Infos[I].LoRev, Infos[I].HiRev) then + begin + FoundBN := Infos[I].Build; + FoundExtra := Infos[I].Name; + FoundVersion := Infos[I].Version; + Result := True; + Break; + end; + end; +end; + +function FindWin10PreviewBuildNameAndExtraFrom(const Builds: array of Integer; + const Win10Version: string; var FoundBN: Integer; var FoundExtra: string): + Boolean; +var + I: Integer; +begin + FoundBN := 0; + FoundExtra := ''; + Result := False; + for I := Low(Builds) to High(Builds) do + begin + if IsBuildNumber(Builds[I]) then + begin + FoundBN := Builds[I]; + FoundExtra := Format( + 'Version %s Preview Build %d', [Win10Version, FoundBN] + ); + Result := True; + Break; + end; + end; +end; + // Checks if the OS has the given product type. // Assumes VerifyVersionInfo & VerSetConditionMask APIs functions are available function IsWindowsProductType(ProductType: Byte): Boolean; @@ -1561,6 +2259,33 @@ function GetRegistryInt(const RootKey: HKEY; const SubKey, Name: string): end; end; +function GetRegistryBytes(const RootKey: HKEY; const SubKey, Name: string): + TBytes; +var + Reg: TRegistry; // registry access object + ValueInfo: TRegDataInfo; // info about registry value +begin + SetLength(Result, 0); + // Open registry at required root key + Reg := RegCreate; + try + Reg.RootKey := RootKey; + if RegOpenKeyReadOnly(Reg, SubKey) and Reg.ValueExists(Name) then + begin + // Check if registry value is integer + Reg.GetDataInfo(Name, ValueInfo); + if ValueInfo.RegData <> rdBinary then + raise EPJSysInfo.Create(sBadRegBinType); + SetLength(Result, ValueInfo.DataSize); + Reg.ReadBinaryData(Name, Result[0], Length(Result)); + end; + finally + // Close registry + Reg.CloseKey; + Reg.Free; + end; +end; + // Gets string info for given value from Windows current version key in // registry. function GetCurrentVersionRegStr(ValName: string): string; @@ -1586,12 +2311,21 @@ procedure InitPlatformIdEx; GetVersionEx: TGetVersionEx; // pointer to GetVersionEx API function GetProductInfo: TGetProductInfo; // pointer to GetProductInfo API function SI: TSystemInfo; // structure from GetSystemInfo API call + VersionEx: Word; // gets extra version info (Win 10/11) + + // Get OS's revision number from registry. + function GetOSRevisionNumber(const IsNT: Boolean): Integer; + begin + Result := GetRegistryInt( + HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[IsNT], 'UBR' + ); + end; - // Return name of Windows Server 2019 insider preview release for given build - // number. Build must be a valid insider preview release number - function Win2019IPExtra(const Build: Integer): string; + // Append "Moment N" to InternalExtraUpdateInfo + procedure AppendMomentToInternalExtraUpdateInfo(N: Cardinal); begin - Result := Format('Insider Preview Build %d', [Build]); + InternalExtraUpdateInfo := InternalExtraUpdateInfo + + ' Moment ' + IntToStr(N); end; begin @@ -1618,6 +2352,7 @@ procedure InitPlatformIdEx; // calls below indirectly call VerifyVersionInfo API, which is only defined // for Windows 2000 and later. InternalPlatform := VER_PLATFORM_WIN32_NT; + InternalRevisionNumber := GetOSRevisionNumber(True); Win32HaveExInfo := True; NewGetVersion( InternalMajorVersion, InternalMinorVersion, @@ -1634,31 +2369,31 @@ procedure InitPlatformIdEx; Win32ProductType := 0; // NOTE: It's going to be very slow to test for all possible build numbers, // so I've narrowed the search down using the information at - // http://en.wikipedia.org/wiki/Windows_NT + // https://en.wikipedia.org/wiki/Windows_NT case InternalMajorVersion of 6: begin case InternalMinorVersion of 0: // Vista - InternalBuildNumber := WinVistaBaseBuild + Win32ServicePackMajor; + InternalBuildNumber := WinVista_Base_Build + Win32ServicePackMajor; 1: // Windows 7 - InternalBuildNumber := Win7BaseBuild + Win32ServicePackMajor; + InternalBuildNumber := Win7_Base_Build + Win32ServicePackMajor; 2: // Windows 8 (no known SPs) if Win32ServicePackMajor = 0 then - InternalBuildNumber := Win8Build; + InternalBuildNumber := Win8_Build; 3: // Windows 8.1 (no known SPs) if Win32ServicePackMajor = 0 then - InternalBuildNumber := Win8Point1Build; + InternalBuildNumber := Win8Point1_Build; 4: if (Win32ProductType = VER_NT_DOMAIN_CONTROLLER) or (Win32ProductType = VER_NT_SERVER) then begin // Windows 2016 Server tech preview 1 - InternalBuildNumber := Win2016TP1Build; + InternalBuildNumber := Win2016_TP1_Build; InternalExtraUpdateInfo := 'Technical Preview 6'; end; end; @@ -1666,7 +2401,7 @@ procedure InitPlatformIdEx; // ** Tried to read this info from registry, but for some weird // reason the required value is reported as non-existant by // TRegistry, even though it is present in registry. - // ** Seems there is some kind of regitry "spoofing" going on (see + // ** Seems there is some kind of registry "spoofing" going on (see // below. InternalCSDVersion := Format( 'Service Pack %d', [Win32ServicePackMajor] @@ -1676,170 +2411,524 @@ procedure InitPlatformIdEx; begin case InternalMinorVersion of 0: + // ** As of 2022/06/01 all releases of Windows 10 **and** + // Windows 11 report major version 10 and minor version 0 + // Well that's helpful!! if (Win32ProductType <> VER_NT_DOMAIN_CONTROLLER) and (Win32ProductType <> VER_NT_SERVER) then begin - if IsBuildNumber(Win10TH1Build) then - begin - InternalBuildNumber := Win10TH1Build; - InternalExtraUpdateInfo := 'Version 1507'; // 1st Win 10 version - end - else if IsBuildNumber(Win10TH2Build) then - begin - InternalBuildNumber := Win10TH2Build; - InternalExtraUpdateInfo := 'Version 1511: November Update'; - end - else if IsBuildNumber(Win10RS1Build) then - begin - InternalBuildNumber := Win10RS1Build; - InternalExtraUpdateInfo := 'Version 1607: Anniversary Update'; - end - else if IsBuildNumber(Win10RS2Build) then + if FindBuildNameAndExtraFrom( + Win10_BuildMap, InternalBuildNumber, InternalExtraUpdateInfo, + VersionEx + ) then begin - InternalBuildNumber := Win10RS2Build; - InternalExtraUpdateInfo := 'Version 1703: Creators Update'; + InternalWin1011Version := + TPJWin10PlusVersion(VersionEx); end - else if IsBuildNumber(Win10RS3Build) then + else if IsBuildNumber(Win10_21H1_Build) then begin - InternalBuildNumber := Win10RS3Build; - InternalExtraUpdateInfo := 'Version 1709: Fall Creators Update'; + // **REF3** + InternalBuildNumber := Win10_21H1_Build; + InternalWin1011Version := win10v21H1; + case InternalRevisionNumber of + 985, 1023, 1052, 1055, 1081, 1082, 1083, 1110, 1151, 1165, 1202, + 1237, 1266, 1288, 1320, 1348, 1387, 1415, 1466, 1469, 1503, + 1526, 1566, 1586, 1620, 1645, 1682, 1706, 1708, 1741, 1766, + 1767, 1806, 1826, 1865, 1889, 1949, 2006, 2075, 2130, 2132, + 2193, 2194, 2251, 2311, 2364 {final build}: + InternalExtraUpdateInfo := 'Version 21H1'; + 1147, 1149, 1200, 1263, 1319, 1379, 1381: + InternalExtraUpdateInfo := Format( + 'Version 21H1 [Release Preview Channel v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + 844, 867, 899, 906, 928, 962, 964: + InternalExtraUpdateInfo := Format( + 'Version 21H1 [Beta Channel v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Version 21H1 [Unknown release v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win10RS4Build) then + else if IsBuildNumber(Win10_21H2_Build) then begin - InternalBuildNumber := Win10RS4Build; - InternalExtraUpdateInfo := 'Version 1803: April 2018 Update'; + // **REF4** + // From 21H2 Windows 10 moves from a 6 monthly update cycle to a + // yearly cycle + InternalBuildNumber := Win10_21H2_Build; + InternalWin1011Version := win10v21H2; + case InternalRevisionNumber of + 1288, 1348, 1387, 1415, 1466, 1469, 1503, 1526, 1566, 1586, + 1620, 1645, 1682, 1706, 1708, 1741, 1766, 1767, 1806, 1826, + 1865, 1889, 1949, 2006, 2075, 2130, 2132, 2193, 2194, 2251, + 2311, 2364, 2486, 2546, 2604, 2673, 2728, 2788, 2846, 2965, + 3086, 3208, 3324, 3448, 3570, 3693, 3803, 3930, 4046, + 4170, 4291, 4412, 4529, 4651, 4780, 4894 .. MaxInt: + InternalExtraUpdateInfo := 'Version 21H2'; + 1147, 1149, 1151, 1165, 1200, 1202, 1237, 1263, 1266, 1319, + 1320, 1379, 1381, 1499, 1618, 1679, 1737, 1739, 1862, + 1947, 2192, 2545: + InternalExtraUpdateInfo := Format( + 'Version 21H2 [Release Preview Channel v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Version 21H2 [Unknown release v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win10RS5Build) then + else if IsBuildNumber(Win10_22H2_Build) then begin - InternalBuildNumber := Win10RS5Build; - InternalExtraUpdateInfo := 'Version 1809: October 2018 Update'; + // **REF5** + InternalBuildNumber := Win10_22H2_Build; + InternalWin1011Version := win10v22H2; + case InternalBuildNumber of + 2006, 2130, 2132, 2193, 2194, 2251, 2311, 2364, 2486, 2546, + 2604, 2673, 2728, 2788, 2846, 2913, 2965, 3031, 3086, 3208, + 3271, 3324, 3393, 3448, 3516, 3570, 3636, 3693, 3758, 3803, + 3930, 3996, 4046, 4123, 4170, 4239, 4291, 4355, 4412, 4474, + 4529, 4598, 4651, 4717, 4780, 4842, 4894, 4957 .. MaxInt: + InternalExtraUpdateInfo := 'Version 22H2'; + 1865, 1889, 1949, 2075, 2301, 2670, 2787, 2908, 3030, 3154, + 3155, 3269, 3391, 3513, 3754, 3757, 3992, 4116, 4233, 4235, + 4353, 4472: + InternalExtraUpdateInfo := Format( + 'Version 22H2 [Release Preview Channel v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + 4593, 4713, 4955: + InternalExtraUpdateInfo := Format( + 'Version 22H2 ' + + '[Beta and Release Preview Channels v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Version 22H2 [Unknown release v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win1019H1Build) then + // Win 11 releases are reporting v10.0 + // Details taken from: https://tinyurl.com/usupsz4a + else if IsBuildNumber(Win11_Dev_Build) then begin - InternalBuildNumber := Win1019H1Build; - InternalExtraUpdateInfo := 'Version 1903: May 2019 Update'; + InternalBuildNumber := Win11_Dev_Build; + InternalWin1011Version := win10plusUnknown; + InternalExtraUpdateInfo := Format( + 'Dev [Insider v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ) end - else if IsBuildNumber(Win1019H2Build) then + else if IsBuildNumber(Win11_21H2_Build) then begin - InternalBuildNumber := Win1019H2Build; - InternalExtraUpdateInfo := 'Version 1909: Novermber 2019 Update'; + // **REF6** + // There are several Win 11 releases with this build number + // Which release we're talking about depends on the revision + // number. + // *** Amazingly one of them, revision 194, is the 1st public + // release of Win 11 -- well hidden eh?! + InternalBuildNumber := Win11_21H2_Build; + InternalWin1011Version := win11v21H2; + case InternalRevisionNumber of + 194, 258, 282, 348, 376, 434, 438, 469, 493, 527, 556, 593, 613, + 652, 675, 708, 739, 740, 778, 795, 832, 856, 918, 978, 1042, + 1098, 1100, 1165, 1219, 1281, 1335, 1455, 1516, 1574, 1641, + 1696, 1761, 1817, 1880, 1936, 2003, 2057, 2124, 2176, 2245, + 2295, 2360, 2416, 2482, 2538, 2600, 2652, 2713, 2777, + 2836, 2899, 2960, 3019, 3079, 3147, 3197 .. MaxInt: + // Public releases of Windows 11 + InternalExtraUpdateInfo := 'Version 21H2'; + 51, 65, 71: + InternalExtraUpdateInfo := Format( + 'Version 21H2 [Dev Channel v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + 100, 120, 132, 160, 168: + InternalExtraUpdateInfo := Format( + 'Version 21H2 [Dev & Beta Channels v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + 176, 184, 346, 466, 526, 588: + InternalExtraUpdateInfo := Format( + 'Version 21H2 ' + + '[Beta & Release Preview Channels v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + 651, 706, 776, 829, 917, 1041, 1163, 1279, 1515, 1639, 1757, + 1879, 2001, 2121, 2243, 2359, 2479: + InternalExtraUpdateInfo := Format( + 'Version 21H2 Release Preview Channel v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Version 21H2 [Unknown release v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win1020H1Build) then + else if IsBuildNumber(Win11_22H2_Build) then begin - InternalBuildNumber := Win1020H1Build; - // TODO: Add marketing name below once known - InternalExtraUpdateInfo := 'Version 2004'; + // **REF1** + InternalBuildNumber := Win11_22H2_Build; + InternalWin1011Version := win11v22H2; + case InternalRevisionNumber of + 382, 521, 525, 608, 674, 675, 755, 819, 900, 963, 1105, 1194, + 1265, 1344, 1413, 1485, 1555, 1635, 1702, 1778, 1848, 1926, + 1928, 1992, 2070, 2134, 2215, 2283, 2361, 2428, 2506, 2715, + 2792, 2861, 3007, 3085, 3155, 3235, 3296, 3374, 3447, 3527, + 3593, 3672, 3737, 3810, 3880, 3958, 4037, 4112, 4169, 4249 + .. MaxInt: + begin + InternalExtraUpdateInfo := 'Version 22H2'; + case InternalRevisionNumber of + 675: AppendMomentToInternalExtraUpdateInfo(1); + 1344: AppendMomentToInternalExtraUpdateInfo(2); + 1778: AppendMomentToInternalExtraUpdateInfo(3); + 2361: AppendMomentToInternalExtraUpdateInfo(4); + 3235: AppendMomentToInternalExtraUpdateInfo(5); + end; + end; + 1: + InternalExtraUpdateInfo := Format( + 'Version 22H2 [Beta & Release Preview v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + 105, 169, 232, 317, 457, 607, 754, 898, 1192, 1343, 1483, 1631, + 1776, 2066, 2213, 2359, 2500, 2787, 3078, 3227, 3371, 3520, + 3668, 3807, 3951, 4108, 4247: + InternalExtraUpdateInfo := Format( + 'Version 22H2 [Release Preview v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + 160, 290, 436, 440, 450, 575, 586, 590, 598, 601, 730, 741, 746, + 870, 875, 885, 891, 1020, 1028, 1037, 1095, 1180, 1245, 1250, + 1255, 1325, 1391, 1465, 1470, 1537, 1546, 1616, 1680, 1690, + 1755, 1825, 1830, 1835, 1900, 1906, 1972, 2048, 2050, 2115, + 2129, 2191, 2199, 2262, 2265, 2271, 2338: + InternalExtraUpdateInfo := Format( + 'Version 22H2 [Beta v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Version 22H2 [Unknown release v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - end - else - begin - // Check for Win Server 2016 echnical previews. - // We don't check for TP1 // here because that reported version 6.4, - // not version 10! - if IsBuildNumber(Win2016TP2Build) then + else if IsBuildNumber(Win11_23H2_Build) then begin - InternalBuildNumber := Win2016TP2Build; - InternalExtraUpdateInfo := 'Technical Preview 2'; + // **REF10** + InternalBuildNumber := Win11_23H2_Build; + InternalWin1011Version := win11v23H2; + case InternalRevisionNumber of + 2428, 2506, 2715, 2792, 2861, 3007, 3085, 3155, 3235 {Moment 5}, + 3296, 3374, 3447, 3527, 3593, 3672, 3737, 3810, 3880, 3958, + 4037, 4112, 4169, 4249 .. MaxInt: + InternalExtraUpdateInfo := 'Version 23H2'; + 1825, 1830, 1835, 1900, 1906, 1972: + begin + // revisions 1825..1972 had version string "22H2" + InternalWin1011Version := win11v22H2; + InternalExtraUpdateInfo := Format( + 'Version 22H2 [Beta v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; + 2048, 2050, 2115, 2129, 2191, 2199, 2262, 2265, 2271, 2338: + InternalExtraUpdateInfo := Format( + 'Version 23H2 [Beta v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + 2361, 2787, 3078, 3227, 3371, 3520, 3668, 3807, 3951, 4108, + 4247: + InternalExtraUpdateInfo := Format( + 'Version 23H2 [Release Preview v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Version 23H2 [Unknown release v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win2016TP3Build) then + else if IsBuildNumber(Win11_24H2_Build) then begin - InternalBuildNumber := Win2016TP3Build; - InternalExtraUpdateInfo := 'Technical Preview 3'; + // **REF11** + InternalBuildNumber := Win11_24H2_Build; + InternalWin1011Version := win11v24H2; + case InternalRevisionNumber of + 1742, 1882 .. MaxInt: + InternalExtraUpdateInfo := 'Version 24H2'; + 560, 712, 863, 994, 1000, 1150, 1297, 1301, 1457, 1586, 1591: + InternalExtraUpdateInfo := Format( + 'Version 24H2 [Release Preview v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); + 1: + InternalExtraUpdateInfo := Format( + 'Version 24H2 [Dev & Canary Channel v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); + 268: + InternalExtraUpdateInfo := Format( + 'Version 24H2 [Dev Channel v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Version 24H2 [Unknown release v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win2016TP4Build) then + else if FindBuildNumberFrom( + Win11_24H2_DevAndCanaryChannel_Builds, InternalBuildNumber + ) then begin - InternalBuildNumber := Win2016TP4Build; - InternalExtraUpdateInfo := 'Technical Preview 4'; + // Win11 builds in Canary, Dev & Preview channels with version + // string "24H2" + InternalWin1011Version := win10plusUnknown; + InternalExtraUpdateInfo := Format( + 'Dev or Canary Channel Version 24H2 v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); end - else if IsBuildNumber(Win2016TP5Build) then + else if FindBuildNumberFrom( + Win11_24H2_CanaryChannel_Builds, InternalBuildNumber + ) then begin - InternalBuildNumber := Win2016TP5Build; - InternalExtraUpdateInfo := 'Technical Preview 5'; + // Win11 builds in Canary channel with version string "24H2" + InternalWin1011Version := win10plusUnknown; + InternalExtraUpdateInfo := Format( + 'Canary Channel Version 24H2 v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); end - else if IsBuildNumber(Win2016RTMBuild) then + else if IsBuildNumber(Win11_Oct22Component_BetaChannel_Build) then begin - InternalBuildNumber := Win2016RTMBuild; - InternalExtraUpdateInfo := 'Version 1607'; + // **REF2** + InternalBuildNumber := Win11_Oct22Component_BetaChannel_Build; + InternalWin1011Version := win10plusUnknown; + case InternalRevisionNumber of + 290, 436, 440, 450, 575, 586, 590, 598, 601: + InternalExtraUpdateInfo := Format( + 'Version 22H2 [October Component Update v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Version 22H2 [Unknown release v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win2016v1709Build) then + else if FindBuildNumberFrom( + Win11_22H2_DevAndBetaChannel_Builds, InternalBuildNumber + ) then begin - InternalBuildNumber := Win2016v1709Build; - InternalExtraUpdateInfo := 'Version 1709'; + // Win 11 Dev & Beta channel builds with version string "22H2" + InternalWin1011Version := win10plusUnknown; + InternalExtraUpdateInfo := Format( + 'Dev & Beta Channels v10.0.%d.%d (22H2)', + [InternalBuildNumber, InternalRevisionNumber] + ); end - else if IsBuildNumber(Win2016v1803Build) then + else if IsBuildNumber(Win11_Feb23Component_BetaChannel_Build) then begin - InternalBuildNumber := Win2016v1803Build; - InternalExtraUpdateInfo := 'Version 1803'; + // **REF7** + InternalBuildNumber := Win11_Feb23Component_BetaChannel_Build; + InternalWin1011Version := win10plusUnknown; + case InternalRevisionNumber of + 730, 741, 746, 870, 875, 885, 891, 1020, 1028, 1037, 1095, + 1180, 1245, 1250, 1255, 1325 .. MaxInt: + InternalExtraUpdateInfo := Format( + 'February 2023 Component Update Beta v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'February 2023 Component Update [Unknown Beta v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win2019IP180320Build) then + else if IsBuildNumber(Win11_May23Component_BetaChannel_Build) then begin - InternalBuildNumber := Win2019IP180320Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180320Build); + // **REF8** + InternalBuildNumber := Win11_May23Component_BetaChannel_Build; + InternalWin1011Version := win10plusUnknown; + case InternalRevisionNumber of + 1391, 1465, 1470, 1537, 1546, 1610, 1616, 1680, 1690, 1755 .. + MaxInt: + InternalExtraUpdateInfo := Format( + 'May 2023 Component Update Beta v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'May 2023 Component Update [Unknown Beta v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win2019IP180324Build) then + else if IsBuildNumber(Win11_FutureComponent_BetaChannel_Build) then begin - InternalBuildNumber := Win2019IP180324Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180324Build); + // **REF9** + InternalBuildNumber := Win11_FutureComponent_BetaChannel_Build; + InternalWin1011Version := win10plusUnknown; + case InternalRevisionNumber of + 2419, 2483, 2486, 2552, 2700, 2771, 2776, 2841, 2850, 2915, + 2921, 3061, 3066, 3130, 3139, 3140, 3209, 3212, 3276, 3286, + 3350, 3420, 3430, 3495, 3500, 3566, 3570, 3575, 3640, 3646, + 3720, 3785, 3790, 3858, 3930, 3936, 4000, 4005, 4010, 4076, + 4082, 4145, 4225, 4291 .. MaxInt: + InternalExtraUpdateInfo := Format( + 'Future Component Update Beta v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Future Component Update [Unknown Beta v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win2019IP180515Build) then + else if IsBuildNumber(Win11_FutureComponent_DevChannel_Build) then begin - InternalBuildNumber := Win2019IP180515Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180515Build); + // **REF12** + InternalBuildNumber := Win11_FutureComponent_DevChannel_Build; + InternalWin1011Version := win10plusUnknown; + case InternalRevisionNumber of + 461, 470, 670, 751, 770, 961, 1252, 1330, 1340, 1350, 1542, + 1843, 1912 .. MaxInt: + InternalExtraUpdateInfo := Format( + 'Future Component Update Dev Channel v10.0.%d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); + else + InternalExtraUpdateInfo := Format( + 'Future Component Update [Unknown Beta v10.0.%d.%d]', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win2019IP180619Build) then + // End with some much less likely cases + // NOTE: All the following tests MUST come after the last call to + // FindBuildNameAndExtraFrom() for non-server OSs because some + // build numbers are common to both sets of tests and the + // following rely on FindBuildNameAndExtraFrom() to have + // filtered out releases. + else if FindWin10PreviewBuildNameAndExtraFrom( + Win10_20H2_Preview_Builds, '20H2', + InternalBuildNumber, InternalExtraUpdateInfo + ) then begin - InternalBuildNumber := Win2019IP180619Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180619Build); + InternalWin1011Version := win10v20H2; end - else if IsBuildNumber(Win2019IP180710Build) then + else if FindWin10PreviewBuildNameAndExtraFrom( + Win10_2004_Preview_Builds, '2004', + InternalBuildNumber, InternalExtraUpdateInfo + ) then begin - InternalBuildNumber := Win2019IP180710Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180710Build); + InternalWin1011Version := win10v2004; end - else if IsBuildNumber(Win2019IP180716Build) then + else if IsBuildNumber(Win10_19XX_Shared_Build) then begin - InternalBuildNumber := Win2019IP180716Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180716Build); + // If we get here the Win10_19XX_Shared_Build will either be a + // preview of Version 1903 or 1909 + InternalBuildNumber := Win10_19XX_Shared_Build; + if IsInRange(InternalRevisionNumber, 0, 113) then + begin + InternalWin1011Version := win10v1903; + InternalExtraUpdateInfo := Format( + 'Version 1903 Preview Build %d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ) + end + else if IsInRange(InternalRevisionNumber, 10000, 10024) then + begin + InternalWin1011Version := win10v1909; + InternalExtraUpdateInfo := Format( + 'Version 1909 Preview Build %d.%d', + [InternalBuildNumber, InternalRevisionNumber] + ); + end; end - else if IsBuildNumber(Win2019IP180716Build) then + else if FindWin10PreviewBuildNameAndExtraFrom( + Win10_1903_Preview_Builds, '1903', + InternalBuildNumber, InternalExtraUpdateInfo + ) then begin - InternalBuildNumber := Win2019IP180716Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180716Build); + InternalWin1011Version := win10v1903; end - else if IsBuildNumber(Win2019IP180731Build) then + else if FindWin10PreviewBuildNameAndExtraFrom( + Win10_1809_Preview_Builds, '1809', + InternalBuildNumber, InternalExtraUpdateInfo + ) then begin - InternalBuildNumber := Win2019IP180731Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180731Build); + InternalWin1011Version := win10v1809; end - else if IsBuildNumber(Win2019IP180814Build) then + else if FindWin10PreviewBuildNameAndExtraFrom( + Win10_1803_Preview_Builds, '1803', + InternalBuildNumber, InternalExtraUpdateInfo + ) then begin - InternalBuildNumber := Win2019IP180814Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180814Build); + InternalWin1011Version := win10v1803; end - else if IsBuildNumber(Win2019IP180821Build) then + else if FindWin10PreviewBuildNameAndExtraFrom( + Win10_1709_Preview_Builds, '1709', + InternalBuildNumber, InternalExtraUpdateInfo + ) then begin - InternalBuildNumber := Win2019IP180821Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180821Build); + InternalWin1011Version := win10v1709; end - else if IsBuildNumber(Win2019IP180828Build) then + else if FindWin10PreviewBuildNameAndExtraFrom( + Win10_1703_Preview_Builds, '1703', + InternalBuildNumber, InternalExtraUpdateInfo + ) then begin - InternalBuildNumber := Win2019IP180828Build; - InternalExtraUpdateInfo := Win2019IPExtra(Win2019IP180828Build); + InternalWin1011Version := win10v1703; end - else if IsBuildNumber(Win2019v1809Build) then + else if FindWin10PreviewBuildNameAndExtraFrom( + Win10_1607_Preview_Builds, '1607', + InternalBuildNumber, InternalExtraUpdateInfo + ) then begin - InternalBuildNumber := Win2019v1809Build; - InternalExtraUpdateInfo := 'Version 1809'; + InternalWin1011Version := win10v1607; end - else if IsBuildNumber(Win2019v1903Build) then + end + else // Win32ProductType in [VER_NT_DOMAIN_CONTROLLER, VER_NT_SERVER] + begin + // Check for the easy-to-handle Win Server v10. builds, i.e. the + // ones where Extra Update Info is just plain text. + if FindBuildNameAndExtraFrom( + WinServerSimpleBuildMap, + InternalBuildNumber, + InternalExtraUpdateInfo, + VersionEx // unused + ) then begin - InternalBuildNumber := Win2019v1903Build; - InternalExtraUpdateInfo := 'Version 1903'; + // Nothing to do: required internal variables set in function call end - else if IsBuildNumber(Win2019v1909Build) then + else if FindBuildNumberFrom( + Win2019_IP_Builds, InternalBuildNumber + ) then begin - InternalBuildNumber := Win2019v1909Build; - InternalExtraUpdateInfo := 'Version 1909'; + // Windows 2019 Insider preview builds require build number in + // Extra Update Info. + InternalExtraUpdateInfo := Format( + 'Insider Preview Build %d', [InternalBuildNumber] + ); end end; end; @@ -1847,10 +2936,11 @@ procedure InitPlatformIdEx; end; // ** If InternalBuildNumber is 0 when we get here then we failed to get it - // We no longer look in registry as of SVN commit r2001, because this can - // get spoofed. E.g. when running on Windows 10 TH2 registry call is - // returning build number of 7600 even though regedit reveals it to be - // 10586 ! + // We no longer look in registry as of SVN commit r2001 (Git commit + // d44aea3e6e0ed7bd317398252fcf862051b159f7 in ddablib/sysinfo on + // GitHub), because this can get spoofed. E.g. when running on Windows 10 + // TH2 registry call is returning build number of 7600 even though + // regedit reveals it to be 10586 ! // So we must now consider a build number of 0 as indicating an unknown // build number. // But note that some users report that their registry is returning @@ -1868,6 +2958,9 @@ procedure InitPlatformIdEx; InternalMinorVersion := Win32MinorVersion; InternalBuildNumber := Win32BuildNumber; InternalCSDVersion := Win32CSDVersion; + InternalRevisionNumber := GetOSRevisionNumber( + InternalPlatform = VER_PLATFORM_WIN32_NT + ); // Try to get extended information {$IFDEF UNICODE} GetVersionEx := LoadKernelFunc('GetVersionExW'); @@ -1916,10 +3009,19 @@ procedure InitPlatformIdEx; GetSystemInfoFn(SI); // Get processor architecture InternalProcessorArchitecture := SI.wProcessorArchitecture; + // Store revision number + Win32RevisionNumber := InternalRevisionNumber; end; { TPJOSInfo } +class function TPJOSInfo.BuildBranch: string; +begin + Result := GetRegistryString( + HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[IsWinNT], 'BuildBranch' + ); +end; + class function TPJOSInfo.BuildNumber: Integer; begin Result := InternalBuildNumber; @@ -1937,11 +3039,15 @@ class function TPJOSInfo.CheckSuite(const Suite: Integer): Boolean; class function TPJOSInfo.Description: string; - // Adds a non-empty string to end of result, preceded by space. - procedure AppendToResult(const Str: string); + // Adds a non-empty string to end of result, optionally preceded by space. + procedure AppendToResult(const Str: string; const WantSpace: Boolean = True); begin if Str <> '' then - Result := Result + ' ' + Str; + begin + if WantSpace then + Result := Result + ' '; + Result := Result + Str; + end; end; begin @@ -1957,15 +3063,22 @@ class function TPJOSInfo.Description: string; // For NT3/4 append version number after product AppendToResult(Format('%d.%d', [MajorVersion, MinorVersion])); AppendToResult(Edition); - AppendToResult(ServicePackEx); // does nothing if no service pack etc + AppendToResult(ServicePackEx); // does nothing if no service pack AppendToResult(Format('(Build %d)', [BuildNumber])); end else begin // Windows 2000 and later: don't include version number AppendToResult(Edition); - AppendToResult(ServicePackEx); // does nothing if no service pack - AppendToResult(Format('(Build %d)', [BuildNumber])); + if (ServicePackEx <> '') then + AppendToResult(', ' + ServicePackEx, False); + if InternalRevisionNumber > 0 then + AppendToResult( + Format(', Build %d.%d', [BuildNumber, InternalRevisionNumber]), + False + ) + else + AppendToResult(Format(', Build %d', [BuildNumber]), False); end; end; ospWin9x: @@ -1974,6 +3087,13 @@ class function TPJOSInfo.Description: string; end; end; +class function TPJOSInfo.DigitalProductID: TBytes; +begin + Result := GetRegistryBytes( + HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[IsWinNT], 'DigitalProductId' + ); +end; + class function TPJOSInfo.Edition: string; begin // This method is based on sample C++ code from MSDN @@ -1983,12 +3103,16 @@ class function TPJOSInfo.Edition: string; osWin7, osWinSvr2008R2, osWin8, osWinSvr2012, osWin8Point1, osWinSvr2012R2, - osWin10, osWin10Svr, osWinSvr2019: + osWin10, osWin11, osWin10Svr, osWinSvr2019, osWinSvr2022, osWinServer: begin // For v6.0 and later we ignore the suite mask and use the new // PRODUCT_ flags from the GetProductInfo() function to determine the // edition + // 1st try to find edition name from lookup table Result := EditionFromProductInfo; + if Result = '' then + // no matching entry in lookup: get from registry + Result := EditionIDFromReg; // append 64-bit if 64 bit system if InternalProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 then Result := Result + ' (64-bit)'; @@ -1998,8 +3122,8 @@ class function TPJOSInfo.Edition: string; osWinSvr2003, osWinSvr2003R2: begin // We check different processor architectures and act accordingly - // This code closely based on MS's sample code found at - // http://msdn2.microsoft.com/en-us/library/ms724429 + // This code closely based on sample code by Microsoft that is no longer + // available if InternalProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64 then begin if CheckSuite(VER_SUITE_DATACENTER) then @@ -2092,7 +3216,7 @@ class function TPJOSInfo.Edition: string; end else // NT before SP6: we read required info from registry - Result := EditionFromReg; + Result := NTEditionFromReg; end; end; end; @@ -2112,19 +3236,10 @@ class function TPJOSInfo.EditionFromProductInfo: string; end; end; -class function TPJOSInfo.EditionFromReg: string; -var - EditionCode: string; // OS product edition code stored in registry +class function TPJOSInfo.EditionIDFromReg: string; begin - EditionCode := ProductTypeFromReg; - if CompareText(EditionCode, 'WINNT') = 0 then - Result := 'WorkStation' - else if CompareText(EditionCode, 'LANMANNT') = 0 then - Result := 'Server' - else if CompareText(EditionCode, 'SERVERNT') = 0 then - Result := 'Advanced Server'; - Result := Result + Format( - ' %d.%d', [InternalMajorVersion, InternalMinorVersion] + Result := GetRegistryString( + HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[IsWinNT], 'EditionID' ); end; @@ -2255,8 +3370,8 @@ class function TPJOSInfo.IsReallyWindows10OrGreater: Boolean; class function TPJOSInfo.IsReallyWindowsVersionOrGreater(MajorVersion, MinorVersion, ServicePackMajor: Word): Boolean; begin - Assert(MajorVersion >= HiByte(_WIN32_WINNT_WIN2K)); - if Assigned(VerSetConditionMask) and Assigned(VerifyVersionInfo) then + if (MajorVersion >= HiByte(_WIN32_WINNT_WIN2K)) + and Assigned(VerSetConditionMask) and Assigned(VerifyVersionInfo) then Result := TestWindowsVersion( MajorVersion, MinorVersion, ServicePackMajor, 0, VER_GREATER_EQUAL ) @@ -2347,6 +3462,29 @@ class function TPJOSInfo.IsWin9x: Boolean; Result := Platform = ospWin9x; end; +class function TPJOSInfo.IsWindows10PlusVersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; +begin + Assert(not (AVersion in [win10plusNA, win10plusUnknown])); + Result := IsReallyWindows10OrGreater and (Windows10PlusVersion >= AVersion); +end; + +class function TPJOSInfo.IsWindows10VersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; +begin + if not (AVersion in Win10_Versions) then + raise EPJSysInfo.Create('Invalid Windows 10 version: can''t compare'); + Result := IsWindows10PlusVersionOrLater(AVersion); +end; + +class function TPJOSInfo.IsWindows11VersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; +begin + if not (AVersion in Win11_Versions) then + raise EPJSysInfo.Create('Invalid Windows 11 version: can''t compare'); + Result := IsWindows10PlusVersionOrLater(AVersion); +end; + class function TPJOSInfo.IsWindowsServer: Boolean; var OSVI: TOSVersionInfoEx; @@ -2404,6 +3542,22 @@ class function TPJOSInfo.MinorVersion: Integer; Result := InternalMinorVersion; end; +class function TPJOSInfo.NTEditionFromReg: string; +var + EditionCode: string; // OS product edition code stored in registry +begin + EditionCode := ProductTypeFromReg; + if CompareText(EditionCode, 'WINNT') = 0 then + Result := 'WorkStation' + else if CompareText(EditionCode, 'LANMANNT') = 0 then + Result := 'Server' + else if CompareText(EditionCode, 'SERVERNT') = 0 then + Result := 'Advanced Server'; + Result := Result + Format( + ' %d.%d', [InternalMajorVersion, InternalMinorVersion] + ); +end; + class function TPJOSInfo.Platform: TPJOSPlatform; begin case InternalPlatform of @@ -2490,20 +3644,24 @@ class function TPJOSInfo.Product: TPJOSProduct; 3: // NOTE: Version 6.3 may only be reported by Windows if the // application is "manifested" for Windows 8.1. See - // http://bit.ly/MJSO8Q. Getting the OS via VerifyVersionInfo - // instead of GetVersion or GetVersionEx should work round this - // for Windows 8.1 (i.e. version 6.3). + // https://tinyurl.com/2s384ha4. Getting the OS via + // VerifyVersionInfo instead of GetVersion or GetVersionEx should + // work round this for Windows 8.1 (i.e. version 6.3). if not IsServer then Result := osWin8Point1 else Result := osWinSvr2012R2; 4: - // Version 6.4 was used for Windows 2016 server tech preview 1. - // This version *may* only be detected by Windows if the - // application is "manifested" for the correct Windows version. - // See http://bit.ly/MJSO8Q. if IsServer then - Result := osWin10Svr; + // Version 6.4 was used for Windows 2016 server tech preview 1. + // This version *may* only be detected by Windows if the + // application is "manifested" for the correct Windows version. + // See https://bit.ly/MJSO8Q. + Result := osWin10Svr + // Version 6.4 was also used for some early Windows 10 preview + // builds, but they have all expired so detection has been + // removed. + // See https://tinyurl.com/3c8e3hsc else // Higher minor version: must be an unknown later OS Result := osWinLater @@ -2513,19 +3671,37 @@ class function TPJOSInfo.Product: TPJOSProduct; begin // NOTE: Version 10 and later may only be reported by Windows if the // application is "manifested" for the correct Windows version. See - // http://bit.ly/MJSO8Q. Previously, getting the OS from + // https://bit.ly/MJSO8Q. Previously, getting the OS from // VerifyVersionInfo instead of GetVersion or GetVersionEx worked // round this, but MS deprecated this in Windows 10, reverting // VerifyVersionInfo to work like GetVersion. WHY????!!!! case InternalMinorVersion of 0: if not IsServer then - Result := osWin10 + begin + if TestBuildNumber(VER_LESS, Win11_First_Build) then + Result := osWin10 + else + // ** As of 2021-10-05 Win 11 is reporting version 10.0! + Result := osWin11; + end else - if InternalBuildNumber <= Win2016LastBuild then + begin + if TestBuildNumber( + VER_LESS_EQUAL, Win2016_Last_Build + ) then Result := osWin10Svr + else if TestBuildNumber( + VER_LESS_EQUAL, Win2019_Last_Build + ) then + Result := osWinSvr2019 + else if TestBuildNumber( + VER_LESS_EQUAL, WinServer_Last_Build + ) then + Result := osWinServer else - Result := osWinSvr2019; + Result := osWinSvr2022; + end; end; end; else @@ -2549,7 +3725,7 @@ class function TPJOSInfo.ProductID: string; class function TPJOSInfo.ProductName: string; begin case Product of - osUnknownWinNT, osUnknownWin9x, osUnknownWin32s: Result := ''; + osUnknown, osUnknownWinNT, osUnknownWin9x, osUnknownWin32s: Result := ''; osWinNT: Result := 'Windows NT'; osWin2K: Result := 'Windows 2000'; osWinXP: Result := 'Windows XP'; @@ -2572,6 +3748,9 @@ class function TPJOSInfo.ProductName: string; osWin10: Result := 'Windows 10'; osWin10Svr: Result := 'Windows Server 2016'; osWinSvr2019: Result := 'Windows Server 2019'; + osWin11: Result := 'Windows 11'; + osWinSvr2022: Result := 'Windows Server 2022'; + osWinServer: Result := 'Windows Server'; else raise EPJSysInfo.Create(sUnknownProduct); end; @@ -2600,6 +3779,11 @@ class function TPJOSInfo.RegisteredOwner: string; ); end; +class function TPJOSInfo.RevisionNumber: Integer; +begin + Result := InternalRevisionNumber; +end; + class function TPJOSInfo.ServicePack: string; begin // Assume no service pack @@ -2655,6 +3839,29 @@ class function TPJOSInfo.ServicePackMinor: Integer; Result := Win32ServicePackMinor; end; +class function TPJOSInfo.Windows10PlusVersion: TPJWin10PlusVersion; +begin + Result := InternalWin1011Version; +end; + +class function TPJOSInfo.Windows10PlusVersionName: string; +const + cVersions: array[TPJWin10PlusVersion] of string = ( + // Not windows 10+ + '', + // Windows 10+ with unknown version string + 'Unknown', + // Windows 10 + '1507', '1511', '1607', '1703', '1709', + '1803', '1809', '1903', '1909', '2004', + '20H2', '21H1', '21H2', '22H2', + // Windows 11 + '21H2', '22H2', '23H2', '24H2' + ); +begin + Result := cVersions[Windows10PlusVersion]; +end; + { TPJComputerInfo } class function TPJComputerInfo.BiosVendor: string; @@ -2783,8 +3990,7 @@ class function TPJComputerInfo.IsUACActive: Boolean; class function TPJComputerInfo.MACAddress: string; type - // Based on code at MSDN knowledge base Q118623 article at - // http://support.microsoft.com/kb/q118623/} + // Based on former MSDN knowledge base article Q118623. // According to MSDN this method should fail on Windows 6.0 (Vista) and later. // It has been known to fail on Vista, but works on Vista Home Premium SP1! // It would seem that the call will succeed if there's an active network with @@ -2841,18 +4047,17 @@ class function TPJComputerInfo.MACAddress: string; if NetBiosSucceeded(Netbios(@Ncb)) then begin // we have a MAC address: return it - with Adapter.Adapt do - Result := Format( - '%.2x-%.2x-%.2x-%.2x-%.2x-%.2x', - [ - Ord(adapter_address[0]), - Ord(adapter_address[1]), - Ord(adapter_address[2]), - Ord(adapter_address[3]), - Ord(adapter_address[4]), - Ord(adapter_address[5]) - ] - ); + Result := Format( + '%.2x-%.2x-%.2x-%.2x-%.2x-%.2x', + [ + Ord(Adapter.Adapt.adapter_address[0]), + Ord(Adapter.Adapt.adapter_address[1]), + Ord(Adapter.Adapt.adapter_address[2]), + Ord(Adapter.Adapt.adapter_address[3]), + Ord(Adapter.Adapt.adapter_address[4]), + Ord(Adapter.Adapt.adapter_address[5]) + ] + ); Exit; end; end; diff --git a/Src/3rdParty/PJVersionInfo.pas b/Src/3rdParty/PJVersionInfo.pas index dbff236c7..d4e0eb8a4 100644 --- a/Src/3rdParty/PJVersionInfo.pas +++ b/Src/3rdParty/PJVersionInfo.pas @@ -1,7 +1,7 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * * Copyright (C) 1998-2014, Peter Johnson (www.delphidabbler.com). * diff --git a/Src/3rdParty/PJWdwState.pas b/Src/3rdParty/PJWdwState.pas index 7ea118261..a99ee5bc1 100644 --- a/Src/3rdParty/PJWdwState.pas +++ b/Src/3rdParty/PJWdwState.pas @@ -1,7 +1,7 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * * Copyright (C) 1999-2014, Peter Johnson (www.delphidabbler.com). * diff --git a/Src/ActiveText.UHTMLRenderer.pas b/Src/ActiveText.UHTMLRenderer.pas index 492823c81..14ad5a3bb 100644 --- a/Src/ActiveText.UHTMLRenderer.pas +++ b/Src/ActiveText.UHTMLRenderer.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2025, Peter Johnson (gravatar.com/delphidabbler). * * Provides a class that renders active text as HTML. } @@ -17,9 +17,9 @@ interface uses // Delphi - SysUtils, Graphics, Generics.Collections, + SysUtils, // Project - ActiveText.UMain, UBaseObjects, UCSSBuilder, UHTMLUtils; + ActiveText.UMain, UHTMLUtils; type @@ -47,7 +47,6 @@ TTagInfo = class(TObject) TCSSStyles = class(TObject) strict private var - fWrapperClass: string; fElemClassMap: array[TActiveTextActionElemKind] of string; procedure SetElemClass(ElemKind: TActiveTextActionElemKind; const Value: string); inline; @@ -55,7 +54,6 @@ TCSSStyles = class(TObject) inline; public constructor Create; - property WrapperClass: string read fWrapperClass write fWrapperClass; property ElemClasses[Kind: TActiveTextActionElemKind]: string read GetElemClass write SetElemClass; end; @@ -63,40 +61,45 @@ TCSSStyles = class(TObject) var fCSSStyles: TCSSStyles; fBuilder: TStringBuilder; - fInBlock: Boolean; + fLevel: Integer; fTagInfoMap: TTagInfoMap; + fIsStartOfTextLine: Boolean; + fLINestingDepth: Cardinal; + fTagGen: THTMLClass; + const + IndentMult = 2; procedure InitialiseTagInfoMap; - procedure InitialiseRender; - procedure RenderTextElem(Elem: IActiveTextTextElem); - procedure RenderBlockActionElem(Elem: IActiveTextActionElem); - procedure RenderInlineActionElem(Elem: IActiveTextActionElem); - procedure FinaliseRender; + function RenderTag(const TagElem: IActiveTextActionElem): string; + function RenderText(const TextElem: IActiveTextTextElem): string; function MakeOpeningTag(const Elem: IActiveTextActionElem): string; function MakeClosingTag(const Elem: IActiveTextActionElem): string; public - constructor Create; + constructor Create(const ATagGenerator: THTMLClass = nil); destructor Destroy; override; function Render(ActiveText: IActiveText): string; - property Styles: TCSSStyles read fCSSStyles; end; implementation - uses - // Project - UColours, UCSSUtils, UFontHelper, UIStringList; + UConsts, UIStringList, UStrUtils; { TActiveTextHTML } -constructor TActiveTextHTML.Create; +constructor TActiveTextHTML.Create(const ATagGenerator: THTMLClass); begin inherited Create; fCSSStyles := TCSSStyles.Create; fBuilder := TStringBuilder.Create; + fLINestingDepth := 0; InitialiseTagInfoMap; + if not Assigned(ATagGenerator) then + // default behaviour before ATagGenerator parameter was added + fTagGen := TXHTML + else + fTagGen := ATagGenerator; end; destructor TActiveTextHTML.Destroy; @@ -110,22 +113,6 @@ destructor TActiveTextHTML.Destroy; inherited; end; -procedure TActiveTextHTML.FinaliseRender; -begin - fBuilder.AppendLine(THTML.ClosingTag('div')); -end; - -procedure TActiveTextHTML.InitialiseRender; -var - WrapperClassAttr: IHTMLAttributes; -begin - if fCSSStyles.WrapperClass <> '' then - WrapperClassAttr := THTMLAttributes.Create('class', fCSSStyles.WrapperClass) - else - WrapperClassAttr := nil; - fBuilder.AppendLine(THTML.OpeningTag('div', WrapperClassAttr)); -end; - procedure TActiveTextHTML.InitialiseTagInfoMap; var NullAttrs: TTagInfo.TTagAttrCallback; @@ -134,7 +121,10 @@ procedure TActiveTextHTML.InitialiseTagInfoMap; ElemKind: TActiveTextActionElemKind; const Tags: array[TActiveTextActionElemKind] of string = ( - 'a', 'strong', 'em', 'var', 'p', 'span', 'h2', 'code' + 'a' {ekLink}, 'strong' {ekStrong}, 'em' {ekEm}, 'var' {ekVar}, 'p' {ekPara}, + 'span' {ekWarning}, 'h2' {ekHeading}, 'code' {ekMono}, + 'ul' {ekUnorderedList}, 'ol' {ekUnorderedList}, 'li' {ekListItem}, + 'div' {ekBlock}, 'div' {ekDocument} ); begin NullAttrs := function(Elem: IActiveTextActionElem): IHTMLAttributes @@ -161,7 +151,7 @@ procedure TActiveTextHTML.InitialiseTagInfoMap; function TActiveTextHTML.MakeClosingTag(const Elem: IActiveTextActionElem): string; begin - Result := THTML.ClosingTag(fTagInfoMap[Elem.Kind].Name); + Result := fTagGen.ClosingTag(fTagInfoMap[Elem.Kind].Name); end; function TActiveTextHTML.MakeOpeningTag(const Elem: IActiveTextActionElem): @@ -176,67 +166,89 @@ function TActiveTextHTML.MakeOpeningTag(const Elem: IActiveTextActionElem): Attrs := THTMLAttributes.Create; Attrs.Add('class', fCSSStyles.ElemClasses[Elem.Kind]) end; - Result := THTML.OpeningTag(fTagInfoMap[Elem.Kind].Name, Attrs); + Result := fTagGen.OpeningTag(fTagInfoMap[Elem.Kind].Name, Attrs); end; function TActiveTextHTML.Render(ActiveText: IActiveText): string; var - Elem: IActiveTextElem; - TextElem: IActiveTextTextElem; - ActionElem: IActiveTextActionElem; + Elem: IActiveTextElem; // each element in active text object + TextElem: IActiveTextTextElem; // an active text text element + TagElem: IActiveTextActionElem; // an active text action element + Text: string; + SrcLines: IStringList; + SrcLine: string; + DestLines: IStringList; + DestLine: string; begin - fBuilder.Clear; - fInBlock := False; - InitialiseRender; + if not ActiveText.HasContent then + Exit(''); + Text := ''; + fLevel := 0; for Elem in ActiveText do begin if Supports(Elem, IActiveTextTextElem, TextElem) then - RenderTextElem(TextElem) - else if Supports(Elem, IActiveTextActionElem, ActionElem) then - begin - if ActionElem.DisplayStyle = dsBlock then - RenderBlockActionElem(ActionElem) - else - RenderInlineActionElem(ActionElem); - end; + Text := Text + RenderText(TextElem) + else if Supports(Elem, IActiveTextActionElem, TagElem) then + Text := Text + RenderTag(TagElem); + end; + SrcLines := TIStringList.Create(Text, EOL, False); + DestLines := TIStringList.Create; + for SrcLine in SrcLines do + begin + DestLine := StrTrimRight(SrcLine); + if not StrIsEmpty(DestLine) then + DestLines.Add(DestLine); end; - FinaliseRender; - Result := fBuilder.ToString; + Result := DestLines.GetText(EOL, False); end; -procedure TActiveTextHTML.RenderBlockActionElem(Elem: IActiveTextActionElem); +function TActiveTextHTML.RenderTag(const TagElem: IActiveTextActionElem): + string; begin - case Elem.State of - fsOpen: - begin - fBuilder.Append(MakeOpeningTag(Elem)); - fInBlock := True; - end; + Result := ''; + case TagElem.State of fsClose: begin - fInBlock := False; - fBuilder.AppendLine(MakeClosingTag(Elem)); + Result := MakeClosingTag(TagElem); + if TActiveTextElemCaps.DisplayStyleOf(TagElem.Kind) = dsBlock then + begin + Dec(fLevel); + Result := EOL + StrOfSpaces(IndentMult * fLevel) + Result + EOL; + fIsStartOfTextLine := True; + end; end; - end; -end; - -procedure TActiveTextHTML.RenderInlineActionElem(Elem: IActiveTextActionElem); -begin - if not fInBlock then - Exit; - case Elem.State of fsOpen: - fBuilder.Append(MakeOpeningTag(Elem)); - fsClose: - fBuilder.Append(MakeClosingTag(Elem)); + begin + Result := MakeOpeningTag(TagElem); + if TActiveTextElemCaps.DisplayStyleOf(TagElem.Kind) = dsBlock then + begin + Result := EOL + StrOfSpaces(IndentMult * fLevel) + Result + EOL; + Inc(fLevel); + fIsStartOfTextLine := True; + end + else if TActiveTextElemCaps.DisplayStyleOf(TagElem.Kind) = dsInline then + begin + if fIsStartOfTextLine then + begin + Result := StrOfSpaces(IndentMult * fLevel) + Result; + fIsStartOfTextLine := False; + end; + end; + end; end; end; -procedure TActiveTextHTML.RenderTextElem(Elem: IActiveTextTextElem); +function TActiveTextHTML.RenderText(const TextElem: IActiveTextTextElem): + string; begin - if not fInBlock then - Exit; - fBuilder.Append(THTML.Entities(Elem.Text)); + if fIsStartOfTextLine then + begin + Result := StrOfSpaces(IndentMult * fLevel); + fIsStartOfTextLine := False; + end + else + Result := ''; + Result := Result + fTagGen.Entities(TextElem.Text); end; { TActiveTextHTML.TCSSStyles } @@ -244,13 +256,15 @@ procedure TActiveTextHTML.RenderTextElem(Elem: IActiveTextTextElem); constructor TActiveTextHTML.TCSSStyles.Create; const DefaultClasses: array[TActiveTextActionElemKind] of string = ( - 'external-link', '', '', '', '', 'warning', '', '' + 'external-link' {ekLink}, '' {ekStrong}, '' {ekEm}, '' {ekVar}, '' {ekPara}, + 'warning' {ekWarning}, '' {ekHeading}, '' {ekMono}, '' {ekUnorderedList}, + '' {ekOrderedList}, '' {ekListItem}, '' {ekBlock}, + 'active-text' {ekDocument} ); var ElemKind: TActiveTextActionElemKind; begin inherited Create; - fWrapperClass := 'active-text'; for ElemKind := Low(TActiveTextActionElemKind) to High(TActiveTextActionElemKind) do SetElemClass(ElemKind, DefaultClasses[ElemKind]); diff --git a/Src/ActiveText.UMain.pas b/Src/ActiveText.UMain.pas index e06bcbaaf..eebd3db1e 100644 --- a/Src/ActiveText.UMain.pas +++ b/Src/ActiveText.UMain.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2023, Peter Johnson (gravatar.com/delphidabbler). * * Provides interfaces, a factory class and implementation of "active text". * Active text is text that can have actions performed on it. Actions may @@ -120,14 +120,19 @@ TActiveTextAttrNames = record type /// <summary>Supported types of active text action elements.</summary> TActiveTextActionElemKind = ( - ekLink, // link element: has a URL (inline) - ekStrong, // text formatted as strong (inline) - ekEm, // text formatted as emphasised (inline) - ekVar, // text formatted as variable (inline) - ekPara, // delimits a paragraph (block level) - ekWarning, // text formatted as a warning (inline) - ekHeading, // delimits a heading (block level) - ekMono // text formatted as mono spaced (inline) + ekLink, // link element: has a URL (inline) + ekStrong, // text formatted as strong (inline) + ekEm, // text formatted as emphasised (inline) + ekVar, // text formatted as variable (inline) + ekPara, // delimits a paragraph (block) + ekWarning, // text formatted as a warning (inline) + ekHeading, // delimits a heading (block level) + ekMono, // text formatted as mono spaced (inline) + ekUnorderedList, // container for unordered lists (block) + ekOrderedList, // container for ordered list (block) + ekListItem, // list item (block) + ekBlock, // container for unexpected text outside block (block) + ekDocument // contains whole document (block) ); type @@ -157,12 +162,6 @@ TActiveTextAttrNames = record function GetAttrs: IActiveTextAttrs; /// <summary>Object describing element's attributes.</summary> property Attrs: IActiveTextAttrs read GetAttrs; - /// <summary>Returns value that indicates whether element is an inline or - /// block element.</summary> - function GetDisplayStyle: TActiveTextDisplayStyle; - /// <summary>Indicates whether element displays inline or as a block. - /// </summary> - property DisplayStyle: TActiveTextDisplayStyle read GetDisplayStyle; end; type @@ -178,15 +177,32 @@ TActiveTextAttrNames = record /// <summary>Appends elements from another given active text object to the /// current object.</summary> procedure Append(const ActiveText: IActiveText); + /// <summary>Returns a new IActiveText instance containing just the first + /// block of the current object.</summary> + /// <remarks> + /// <para>The first block is the content of the block level tag that starts + /// the active text. If this block has child blocks (for e.g. an unordered + /// list) then they are included.</para> + /// <para>If the current object is empty then an empty object is returned. + /// </para> + /// </remarks> + function FirstBlock: IActiveText; /// <summary>Checks if the active text object contains any elements. /// </summary> function IsEmpty: Boolean; + /// <summary>Checks if the active text object has text content.</summary> + function HasContent: Boolean; /// <summary>Checks if the active text object contains only plain text. /// </summary> /// <remarks>Plain text is considered to be active text with no action - /// elements except for "para". This can rendered in plain text with no - /// loss of formatting.</remarks> + /// elements except for "document" or "block". This can rendered in plain + /// text with no loss of formatting.</remarks> function IsPlainText: Boolean; + /// <summary>Checks if the active text object is a valid active text + /// document.</summary> + /// <remarks>A valid document is either empty or it is surrounded by + /// matching ekDocument elements.</remarks> + function IsValidActiveTextDocument: Boolean; /// <summary>Returns element at given index in active text object's element /// list.</summary> function GetElem(Idx: Integer): IActiveTextElem; @@ -273,6 +289,158 @@ TActiveTextFactory = class(TNoConstructObject) IActiveTextAttrs; overload; end; +type + /// <summary>Provides information about the capabilities of each supported + /// active text element.</summary> + TActiveTextElemCaps = record + strict private + type + /// <summary>Fields used to define an active text element's capabilities. + /// </summary> + TCaps = record + public + var + /// <summary>Determines how element is to be displayed.</summary> + DisplayStyle: TActiveTextDisplayStyle; + /// <summary>Specifies whether plain text can be contained within the + /// element.</summary> + PermitsText: Boolean; + /// <summary>Specifies the elements that are permitted as child + /// elements of this element. + PermittedChildElems: TActiveTextActionElemKinds; + end; + const + /// <summary>Set of block level elements.</summary> + BlockElems = [ + ekPara, ekHeading, ekUnorderedList, ekOrderedList, ekListItem, + ekBlock, ekDocument + ]; + /// <summary>Set of block level elements that can directly contain text + /// and inline elements.</summary> + TextContentBlocks = [ + ekPara, ekHeading, ekBlock + ]; + /// <summary>Set of block level elements that can contain only blocks + /// that are not container blocks.</summary> + ContainerBlocks = [ + ekDocument, ekListItem + ]; + /// <summary>Set of inline elements.</summary> + InlineElems = [ + ekLink, ekStrong, ekEm, ekVar, ekWarning, ekMono + ]; + /// <summary>Set of all elements.</summary> + AllElems = BlockElems + InlineElems; + /// <summary>Map of all elements to their capabilities.</summary> + Map: array[TActiveTextActionElemKind] of TCaps = + ( + ( + // ekLink + // may contain any inline elements but no block elements + DisplayStyle: dsInline; + PermitsText: True; + PermittedChildElems: InlineElems - [ekLink]; + ), + ( + // ekStrong + // may contain any inline elements but no block elements + DisplayStyle: dsInline; + PermitsText: True; + PermittedChildElems: InlineElems; + ), + ( + // ekEm + // may contain any inline elements but no block elements + DisplayStyle: dsInline; + PermitsText: True; + PermittedChildElems: InlineElems; + ), + ( + // ekVar + // may contain any inline elements but no block elements + DisplayStyle: dsInline; + PermitsText: True; + PermittedChildElems: InlineElems; + ), + ( + // ekPara + // may contain any inline elements but no block elements + DisplayStyle: dsBlock; + PermitsText: True; + PermittedChildElems: InlineElems; + ), + ( + // ekWarning + // may contain any inline elements but no block elements + DisplayStyle: dsInline; + PermitsText: True; + PermittedChildElems: InlineElems; + ), + ( + // ekHeading + // may contain any inline elements but no block elements + DisplayStyle: dsBlock; + PermitsText: True; + PermittedChildElems: InlineElems; + ), + ( + // ekMono + // may contain any inline elements but no block elements + DisplayStyle: dsInline; + PermitsText: True; + PermittedChildElems: InlineElems; + ), + ( + // ekUnorderedList + // may contain only list item elements + DisplayStyle: dsBlock; + PermitsText: False; + PermittedChildElems: [ekListItem]; + ), + ( + // ekOrderedList + // may contain only list item elements + DisplayStyle: dsBlock; + PermitsText: False; + PermittedChildElems: [ekListItem]; + ), + ( + // ekListItem + // may contain only block elements, but not itself or other + // block containers + DisplayStyle: dsBlock; + PermitsText: False; + PermittedChildElems: BlockElems - ContainerBlocks; + ), + ( + // ekBlock + // may contain any inline elements but no block elements + DisplayStyle: dsBlock; + PermitsText: True; + PermittedChildElems: InlineElems; + ), + ( + // ekDocument + // may contain only block elements, but not itself or other + // block containers + DisplayStyle: dsBlock; + PermitsText: False; + PermittedChildElems: BlockElems - ContainerBlocks; + ) + ); + public + /// <summary>Returns the display type of the given element.</summary> + class function DisplayStyleOf(const Elem: TActiveTextActionElemKind): + TActiveTextDisplayStyle; static; + /// <summary>Checks whether the given element can contain text.</summary> + class function CanContainText(const Elem: TActiveTextActionElemKind): + Boolean; static; + /// <summary>Checks whether the given child element is permitted as a child + /// of the given parent element.</summary> + class function IsPermittedChildElem( + const Parent, Child: TActiveTextActionElemKind): Boolean; static; + end; + implementation @@ -281,7 +449,10 @@ implementation // Delphi SysUtils, // Project - IntfCommon; + IntfCommon, + UConsts, + UStrUtils, + UUtils; type @@ -321,18 +492,40 @@ TActiveText = class(TInterfacedObject, /// </summary> /// <remarks>Method of IActiveText.</remarks> procedure Append(const ActiveText: IActiveText); + /// <summary>Returns a new IActiveText instance containing just the first + /// block of the current object.</summary> + /// <remarks> + /// <para>The first block is the content of the block level tag that starts + /// the active text. If this block has child blocks (for e.g. an unordered + /// list) then they are included.</para> + /// <para>If the current object is empty then an empty object is returned. + /// </para> + /// <para>Method of IActiveText.</para> + /// </remarks> + function FirstBlock: IActiveText; /// <summary>Checks if the element list is empty.</summary> /// <remarks>Method of IActiveText.</remarks> function IsEmpty: Boolean; + /// <summary>Checks if the active text object has text content.</summary> + /// <remarks>Method of IActiveText.</remarks> + function HasContent: Boolean; /// <summary>Checks if the active text object contains only plain text. /// </summary> /// <remarks> /// <para>Plain text is considered to be active text with no action - /// elements except for "para". This can rendered in plain text with no - /// loss of formatting.</para> + /// elements except for "document" or "block". This can rendered in plain + /// text with no loss of formatting.</para> /// <para>Method of IActiveText.</para> /// </remarks> function IsPlainText: Boolean; + /// <summary>Checks if the active text object is a valid active text + /// document.</summary> + /// <remarks> + /// <para>A valid document is either empty or it is surrounded by matching + /// ekDocument elements.</para> + /// <para>Method of IActiveText.</para> + /// </remarks> + function IsValidActiveTextDocument: Boolean; /// <summary>Returns element at given index in element list.</summary> /// <remarks>Method of IActiveText.</remarks> function GetElem(Idx: Integer): IActiveTextElem; @@ -354,7 +547,7 @@ TActiveTextTextElem = class(TInterfacedObject, fText: string; public /// <summary>Object constructor. Records given element text and sets - /// required kind for a text element.</summary> + /// required Elem for a text element.</summary> constructor Create(const Text: string); /// <summary>Assigns properties of another object to this object.</summary> /// <param name="Src">IInterface [in] Object whose properties are to be @@ -375,7 +568,7 @@ TActiveTextActionElem = class(TInterfacedObject, IActiveTextElem, IActiveTextActionElem, IAssignable, IClonable ) strict private - /// <summary>Kind of element encapsulated by this object.</summary> + /// <summary>Elem of element encapsulated by this object.</summary> fKind: TActiveTextActionElemKind; /// <summary>State of element: opening or closing.</summary> fState: TActiveTextElemState; @@ -383,13 +576,14 @@ TActiveTextActionElem = class(TInterfacedObject, fAttrs: IActiveTextAttrs; public /// <summary>Object constructor. Creates an action element.</summary> - /// <param name="Kind">TActiveTextElemKind [in] Required kind of element. + /// <param name="AKind">TActiveTextElemKind [in] Required Elem of element. /// </param> - /// <param name="Attrs">IActiveTextAttrs [in] Element's attributes.</param> - /// <param name="State">TActiveTextElemState [in] State of element: opening - /// or closing.</param> - constructor Create(const Kind: TActiveTextActionElemKind; - Attrs: IActiveTextAttrs; const State: TActiveTextElemState); + /// <param name="AAttrs">IActiveTextAttrs [in] Element's attributes. + /// </param> + /// <param name="AState">TActiveTextElemState [in] State of element: + /// opening or closing.</param> + constructor Create(const AKind: TActiveTextActionElemKind; + AAttrs: IActiveTextAttrs; const AState: TActiveTextElemState); /// <summary>Assigns properties of another object to this object.</summary> /// <param name="Src">IInterface [in] Object whose properties are to be /// assigned. Src must support IActiveTextActionElem.</param> @@ -401,7 +595,7 @@ TActiveTextActionElem = class(TInterfacedObject, /// <summary>Returns a cloned instance of this object.</summary> /// <remarks>Method of IClonable.</remarks> function Clone: IInterface; - /// <summary>Returns kind of action represented by this element.</summary> + /// <summary>Returns Elem of action represented by this element.</summary> /// <remarks>Method of IActiveTextActionElem.</remarks> function GetKind: TActiveTextActionElemKind; /// <summary>Returns state of element.</summary> @@ -410,10 +604,6 @@ TActiveTextActionElem = class(TInterfacedObject, /// <summary>Returns object describing element's attributes.</summary> /// <remarks>Method of IActiveTextActionElem.</remarks> function GetAttrs: IActiveTextAttrs; - /// <summary>Returns value that indicates whether element is an inline or - /// block element.</summary> - /// <remarks>Method of IActiveTextActionElem.</remarks> - function GetDisplayStyle: TActiveTextDisplayStyle; end; type @@ -531,15 +721,43 @@ function TActiveText.AddElem(const Elem: IActiveTextElem): Integer; end; procedure TActiveText.Append(const ActiveText: IActiveText); + + function IsDocumentElem(Elem: IActiveTextElem): Boolean; + var + ActiveElem: IActiveTextActionElem; + begin + if not Supports(Elem, IActiveTextActionElem, ActiveElem) then + Exit(False); + Result := ActiveElem.Kind = ekDocument; + end; + var Elem: IActiveTextElem; // references each element in elems - NewElem: IActiveTextElem; + SelfCopy: IActiveText; // temporary copy of this object begin + // *** Don't call Clone or Assign here: they call backinto this method. + + // Make a copy of elements of self + SelfCopy := TActiveText.Create; + for Elem in fElems do + SelfCopy.AddElem((Elem as IClonable).Clone as IActiveTextElem); + + // Clear own elems and add document start element + fElems.Clear; + AddElem(TActiveTextFactory.CreateActionElem(ekDocument, fsOpen)); + + // Copy own elements back to fElems, skipping ekDocument elems + for Elem in SelfCopy do + if not IsDocumentElem(Elem) then + AddElem((Elem as IClonable).Clone as IActiveTextElem); + + // Copy active text to be assigned, skipping its ekDocument elems for Elem in ActiveText do - begin - NewElem := (Elem as IClonable).Clone as IActiveTextElem; - AddElem(NewElem); - end; + if not IsDocumentElem(Elem) then + AddElem((Elem as IClonable).Clone as IActiveTextElem); + + // Add closing ekDocument Elem + AddElem(TActiveTextFactory.CreateActionElem(ekDocument, fsClose)); end; procedure TActiveText.Assign(const Src: IInterface); @@ -569,6 +787,78 @@ destructor TActiveText.Destroy; inherited; end; +function TActiveText.FirstBlock: IActiveText; +var + Elem: IActiveTextElem; + ActionElem: IActiveTextActionElem; + Block: IActiveTextActionElem; + Idx: Integer; + EndOfBlockFound: Boolean; + HasDocElems: Boolean; + FirstBlockIdx: Integer; +begin + Result := TActiveText.Create; + if IsEmpty then + Exit; + + HasDocElems := IsValidActiveTextDocument; + if HasDocElems then + begin + // We have ekDocument elements wrapping document: 1st true blue should be + // next element + if GetCount < 4 then + Exit; + FirstBlockIdx := 1; + end + else + begin + // No ekDocument elements: 1st true block is should be first element + if GetCount < 2 then + Exit; + FirstBlockIdx := 0; + end; + + // Element at FirstBlockIdx must be a valid block opening element + Elem := GetElem(FirstBlockIdx); + GetIntf(Elem, IActiveTextElem, Block); + if not Assigned(Block) + or (TActiveTextElemCaps.DisplayStyleOf(Block.Kind) <> dsBlock) + or (Block.State <> fsOpen) then + raise EBug.Create( + ClassName + '.FirstBlock: block opener expected after ekDocument element' + ); + + // We have required block: add document opener element and block element + Result.AddElem(TActiveTextFactory.CreateActionElem(ekDocument, fsOpen)); + Result.AddElem(Elem); + + // Scan through remaining elements, copying them to output as we go. Halt when + // (or if) matching closing block found. + EndOfBlockFound := False; + Idx := Succ(FirstBlockIdx); + while Idx < Pred(GetCount) do + begin + Elem := GetElem(Idx); + Result.AddElem(Elem); + if Supports(Elem, IActiveTextActionElem, ActionElem) + and (ActionElem.Kind = Block.Kind) + and (ActionElem.State = fsClose) then + begin + EndOfBlockFound := True; + Break; + end; + Inc(Idx); + end; + // No closing block found + if not EndOfBlockFound then + raise EBug.Create( + ClassName + '.FirstBlock: Matching closer for first block not found' + ); + + // Add document close elem (closing block elem added in loop above) + Result.AddElem(TActiveTextFactory.CreateActionElem(ekDocument, fsClose)); +end; + function TActiveText.GetCount: Integer; begin Result := fElems.Count; @@ -584,6 +874,18 @@ function TActiveText.GetEnumerator: TEnumerator<IActiveTextElem>; Result := fElems.GetEnumerator; end; +function TActiveText.HasContent: Boolean; +var + Elem: IActiveTextElem; + TextElem: IActiveTextTextElem; +begin + Result := False; + for Elem in fElems do + if Supports(Elem, IActiveTextTextElem, TextElem) + and (TextElem.Text <> '') then + Exit(True); +end; + function TActiveText.IsEmpty: Boolean; begin Result := fElems.Count = 0; @@ -597,12 +899,25 @@ function TActiveText.IsPlainText: Boolean; for Elem in fElems do begin if Supports(Elem, IActiveTextActionElem, ActionElem) - and (ActionElem.Kind <> ekPara) then + and not (ActionElem.Kind in [ekBlock, ekDocument]) then Exit(False); end; Result := True; end; +function TActiveText.IsValidActiveTextDocument: Boolean; +var + DocStartElem, DocEndElem: IActiveTextActionElem; +begin + if IsEmpty then + Exit(True); + Result := (GetCount >= 2) + and Supports(fElems[0], IActiveTextActionElem, DocStartElem) + and (DocStartElem.Kind = ekDocument) and (DocStartElem.State = fsOpen) + and Supports(fElems[Pred(GetCount)], IActiveTextActionElem, DocEndElem) + and (DocEndElem.Kind = ekDocument) and (DocEndElem.State = fsClose); +end; + function TActiveText.ToString: string; var Elem: IActiveTextElem; @@ -617,13 +932,13 @@ function TActiveText.ToString: string; if Supports(Elem, IActiveTextTextElem, TextElem) then SB.Append(TextElem.Text); if Supports(Elem, IActiveTextActionElem, ActionElem) - and (ActionElem.DisplayStyle = dsBlock) + and (TActiveTextElemCaps.DisplayStyleOf(ActionElem.Kind) = dsBlock) and (ActionElem.State = fsClose) then // new line at end of block to separate text at end of closing block // from text at start of following block SB.AppendLine; end; - Result := SB.ToString; + Result := StrTrimRight(SB.ToString) + EOL; // ensure single final EOL(s) finally SB.Free; end; @@ -674,13 +989,13 @@ function TActiveTextActionElem.Clone: IInterface; Result := TActiveTextActionElem.Create(GetKind, Attrs, GetState); end; -constructor TActiveTextActionElem.Create(const Kind: TActiveTextActionElemKind; - Attrs: IActiveTextAttrs; const State: TActiveTextElemState); +constructor TActiveTextActionElem.Create(const AKind: TActiveTextActionElemKind; + AAttrs: IActiveTextAttrs; const AState: TActiveTextElemState); begin inherited Create; - fAttrs := Attrs; - fState := State; - fKind := Kind; + fAttrs := AAttrs; + fState := AState; + fKind := AKind; end; function TActiveTextActionElem.GetAttrs: IActiveTextAttrs; @@ -688,14 +1003,6 @@ function TActiveTextActionElem.GetAttrs: IActiveTextAttrs; Result := fAttrs; end; -function TActiveTextActionElem.GetDisplayStyle: TActiveTextDisplayStyle; -begin - if GetKind in [ekPara, ekHeading] then - Result := dsBlock - else - Result := dsInline; -end; - function TActiveTextActionElem.GetKind: TActiveTextActionElemKind; begin Result := fKind; @@ -755,5 +1062,25 @@ function TActiveTextAttrs.GetEnumerator: TEnumerator<TPair<string, string>>; Result := fMap.GetEnumerator; end; +{ TActiveTextElemCapsMap } + +class function TActiveTextElemCaps.CanContainText( + const Elem: TActiveTextActionElemKind): Boolean; +begin + Result := Map[Elem].PermitsText; +end; + +class function TActiveTextElemCaps.DisplayStyleOf( + const Elem: TActiveTextActionElemKind): TActiveTextDisplayStyle; +begin + Result := Map[Elem].DisplayStyle; +end; + +class function TActiveTextElemCaps.IsPermittedChildElem( + const Parent, Child: TActiveTextActionElemKind): Boolean; +begin + Result := Child in Map[Parent].PermittedChildElems; +end; + end. diff --git a/Src/ActiveText.UMarkdownRenderer.pas b/Src/ActiveText.UMarkdownRenderer.pas new file mode 100644 index 000000000..d3678015b --- /dev/null +++ b/Src/ActiveText.UMarkdownRenderer.pas @@ -0,0 +1,927 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2025, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements class that renders active text in Markdown format. +} + + +unit ActiveText.UMarkdownRenderer; + +interface + +uses + // Delphi + SysUtils, + Generics.Collections, + // Project + ActiveText.UMain, + UIStringList; + + +type + /// <summary>Renders active text in Markdown format.</summary> + TActiveTextMarkdown = class(TObject) + strict private + type + + /// <summary>Kinds of inline Markdown formatting.</summary> + TInlineElemKind = ( + iekPlain, // no formatting e.g. text => text + iekWeakEmphasis, // weak emphasis (italic) e.g. text => *text* + iekStrongEmphasis, // strong emphasis (bold) e.g. text => **text** + iekLink, // link e.g. text,url => [text](url) + iekInlineCode // inline code e.g. text => `text` + ); + + /// <summary>Representation of an inline Markdown element.</summary> + TInlineElem = record + strict private + var + fFormatterKind: TInlineElemKind; + fMarkdown: string; + fAttrs: IActiveTextAttrs; + fCanRenderElem: TPredicate<TInlineElemKind>; + public + constructor Create(const AFormatterKind: TInlineElemKind; + const ACanRenderElem: TPredicate<TInlineElemKind>; + const AAttrs: IActiveTextAttrs); + property Kind: TInlineElemKind read fFormatterKind; + property Markdown: string read fMarkdown write fMarkdown; + property Attrs: IActiveTextAttrs read fAttrs; + property CanRenderElem: TPredicate<TInlineElemKind> read fCanRenderElem; + end; + + /// <summary>Stack of inline Markdown elements.</summary> + /// <remarks>Used in rendering all the inline elements within a block. + /// </remarks> + TInlineElemStack = class (TStack<TInlineElem>) + strict private + public + procedure Push(const AFmtKind: TInlineElemKind; + const ACanRenderElem: TPredicate<TInlineElemKind>; + const AAttrs: IActiveTextAttrs); reintroduce; + function IsEmpty: Boolean; + function IsOpen(const AFmtKind: TInlineElemKind): Boolean; + function NestingDepthOf(const AFmtKind: TInlineElemKind): Integer; + procedure AppendMarkdown(const AMarkdown: string); + constructor Create; + destructor Destroy; override; + end; + + /// <summary>Kinds of Markdown containers.</summary> + TContainerKind = ( + ckPlain, // represents main document + ckBulleted, // represents an unordered list item + ckNumbered // represents an ordered list item + ); + + /// <summary>Encapsulates the state of a list (ordered or unordered). + /// </summary> + TListState = record + public + ListNumber: Cardinal; + ListKind: TContainerKind; + constructor Create(AListKind: TContainerKind); + end; + + /// <summary>A stack of currently open lists, with the current, most + /// nested at the top of the stack.</summary> + /// <remarks>Used to keep track of list nesting.</remarks> + TListStack = class(TStack<TListState>) + public + constructor Create; + destructor Destroy; override; + procedure IncTopListNumber; + end; + + /// <summary>Base class for classes that represent a chunk of a Markdown + /// document. A Markdown document contains a sequence of chunks, each of + /// which is either a block level element or a container of other chunks + /// at a deeper level.</summary> + TContentChunk = class abstract + strict private + var + fDepth: UInt8; + fClosed: Boolean; + public + constructor Create(const ADepth: UInt8); + procedure Close; + function IsClosed: Boolean; + procedure Render(const ALines: IStringList); virtual; abstract; + property Depth: UInt8 read fDepth; + end; + + /// <summary>Base class for container chunks that hold a sequence of + /// other chunks at a given depth within a Markdown document.</summary> + TContainer = class abstract (TContentChunk) + strict private + fContent: TObjectList<TContentChunk>; + public + constructor Create(const ADepth: UInt8); + destructor Destroy; override; + function IsEmpty: Boolean; + procedure Add(const AChunk: TContentChunk); + function LastChunk: TContentChunk; + function Content: TArray<TContentChunk>; + function TrimEmptyBlocks: TArray<TContentChunk>; + procedure Render(const ALines: IStringList); override; abstract; + end; + + /// <summary>Encapsulate the Markdown document. Contains a sequence of + /// other chunks within the top level of the document.</summary> + TDocument = class sealed (TContainer) + public + procedure Render(const ALines: IStringList); override; + end; + + /// <summary>Encapsulates a generalised list item, that is a container + /// for chunks at a deeper level within the document.</summary> + TListItem = class abstract (TContainer) + strict private + fNumber: UInt8; + public + constructor Create(const ADepth: UInt8; const ANumber: UInt8); + procedure Render(const ALines: IStringList); override; abstract; + property Number: UInt8 read fNumber; + end; + + /// <summary>Encapsulates a bullet list item that contains a sequence of + /// chunks that belong to the list item.</summary> + TBulletListItem = class sealed (TListItem) + public + constructor Create(const ADepth: UInt8; const ANumber: UInt8); + procedure Render(const ALines: IStringList); override; + end; + + /// <summary>Encapsulates a numbered list item that contains a sequence + /// of chunks that belong to the list item.</summary> + TNumberListItem = class sealed (TListItem) + public + constructor Create(const ADepth: UInt8; const ANumber: UInt8); + procedure Render(const ALines: IStringList); override; + end; + + /// <summary>Encapsulates a generalised Markdown block level item. + /// </summary> + TBlock = class abstract (TContentChunk) + strict private + var + fMarkdownStack: TInlineElemStack; + public + constructor Create(const ADepth: UInt8); + destructor Destroy; override; + property MarkdownStack: TInlineElemStack read fMarkdownStack; + function IsEmpty: Boolean; + procedure Render(const ALines: IStringList); override; abstract; + function RenderStr: string; virtual; abstract; + function LookupElemKind( + const AActiveTextKind: TActiveTextActionElemKind): TInlineElemKind; + end; + + /// <summary>Encapsulates a "fake" Markdown block that is used + /// to contain any active text that exists outside a block level tag or + /// whose direct parent is a list item.</summary> + TSimpleBlock = class sealed (TBlock) + public + procedure Render(const ALines: IStringList); overload; override; + function RenderStr: string; override; + end; + + /// <summary>Encapsulates a Markdown paragraph.</summary> + TParaBlock = class sealed (TBlock) + public + procedure Render(const ALines: IStringList); overload; override; + function RenderStr: string; override; + end; + + /// <summary>Encapsulates a markdown heading (assumed to be at level 2). + /// </summary> + THeadingBlock = class sealed (TBlock) + public + procedure Render(const ALines: IStringList); overload; override; + function RenderStr: string; override; + end; + + /// <summary>A stack of currently open containers.</summary> + /// <remarks>Used to track the parentage of the currently open container. + /// </remarks> + TContainerStack = class(TStack<TContainer>); + + strict private + var + /// <summary>Contains all the content chunks belonging to the top level + /// Markdown document.</summary> + fDocument: TDocument; + /// <summary>Stack that tracks the parentage of any currently open list. + /// </summary> + fListStack: TListStack; + /// <summary>Stack that tracks the parentage of the currently open + /// container.</summary> + fContainerStack: TContainerStack; + /// <summary>Closes and renders the Markdown for the currently open inline + /// element in the given Markdown block.</summary> + procedure CloseInlineElem(const Block: TBlock); + procedure ParseTextElem(Elem: IActiveTextTextElem); + procedure ParseBlockActionElem(Elem: IActiveTextActionElem); + procedure ParseInlineActionElem(Elem: IActiveTextActionElem); + procedure Parse(ActiveText: IActiveText); + public + constructor Create; + destructor Destroy; override; + /// <summary>Parses the given active text and returns a Markdown + /// representation of it.</summary> + function Render(ActiveText: IActiveText): string; + end; + + +implementation + +uses + // Project + UConsts, + UExceptions, + UMarkdownUtils, + UStrUtils; + + +{ TActiveTextMarkdown } + +procedure TActiveTextMarkdown.CloseInlineElem(const Block: TBlock); +var + MElem: TInlineElem; + Markdown: string; +begin + MElem := Block.MarkdownStack.Peek; + // Render markdown + Markdown := ''; + if MElem.CanRenderElem(MElem.Kind) then + begin + // Element should be output, wrapping its markdown + case MElem.Kind of + iekWeakEmphasis: + if not StrIsEmpty(MElem.Markdown) then + Markdown := TMarkdown.WeakEmphasis(MElem.Markdown); + iekStrongEmphasis: + if not StrIsEmpty(MElem.Markdown) then + Markdown := TMarkdown.StrongEmphasis(MElem.Markdown); + iekLink: + if StrIsEmpty(MElem.Attrs[TActiveTextAttrNames.Link_URL]) then + begin + Markdown := MElem.Markdown; // no URL: emit bare markdown + end + else + begin + // we have URL + if not StrIsEmpty(MElem.Markdown) then + // we have inner markdown: emit standard link + Markdown := TMarkdown.Link( + MElem.Markdown, MElem.Attrs[TActiveTextAttrNames.Link_URL] + ) + else + // no inner text: emit bare URL + Markdown := TMarkdown.BareURL( + MElem.Attrs[TActiveTextAttrNames.Link_URL] + ); + end; + iekInlineCode: + if not StrIsEmpty(MElem.Markdown) then + begin + // Note: <mono>`foo`</mono> should be rendered as `` `foo` ``, not + // ```foo```, but for any other leading or trailing character than ` + // don't prefix with space. + // Also don't add space for other leading / trailing chars, so + // <mono>[foo]</mono> is rendered as `[foo]` and <mono>[`foo`]</mono> + // is rendered as ``[`foo`]`` + Markdown := MElem.Markdown; + if Markdown[1] = '`' then + Markdown := ' ' + Markdown; + if Markdown[Length(Markdown)] = '`' then + Markdown := Markdown + ' '; + Markdown := TMarkdown.InlineCode(Markdown); + end; + end; + end + else + // Ingoring element: keep its inner markdown + Markdown := MElem.Markdown; + // Pop stack & add markdown to that of new stack top + Block.MarkdownStack.Pop; + // stack should contain at least a block element below all inline elements + Assert(not Block.MarkdownStack.IsEmpty); + Block.MarkdownStack.AppendMarkdown(Markdown); +end; + +constructor TActiveTextMarkdown.Create; +begin + fDocument := TDocument.Create(0); + fContainerStack := TContainerStack.Create; + fListStack := TListStack.Create; +end; + +destructor TActiveTextMarkdown.Destroy; +begin + fListStack.Free; + fContainerStack.Free; + fDocument.Free; + inherited; +end; + +procedure TActiveTextMarkdown.Parse(ActiveText: IActiveText); +var + Elem: IActiveTextElem; + TextElem: IActiveTextTextElem; + ActionElem: IActiveTextActionElem; +begin + fContainerStack.Clear; + fContainerStack.Push(fDocument); + + if ActiveText.IsEmpty then + Exit; + + Assert( + Supports(ActiveText[0], IActiveTextActionElem, ActionElem) + and (ActionElem.Kind = ekDocument), + ClassName + '.Parse: Expected ekDocument at start of active text' + ); + + for Elem in ActiveText do + begin + if Supports(Elem, IActiveTextTextElem, TextElem) then + ParseTextElem(TextElem) + else if Supports(Elem, IActiveTextActionElem, ActionElem) then + begin + if TActiveTextElemCaps.DisplayStyleOf(ActionElem.Kind) = dsBlock then + ParseBlockActionElem(ActionElem) + else + ParseInlineActionElem(ActionElem); + end; + end; + +end; + +procedure TActiveTextMarkdown.ParseBlockActionElem(Elem: IActiveTextActionElem); +var + CurContainer, NewContainer: TContainer; +begin + + CurContainer := fContainerStack.Peek; + + case Elem.State of + + fsOpen: + begin + case Elem.Kind of + ekDocument: + ; // do nothing + ekUnorderedList: + fListStack.Push(TListState.Create(ckBulleted)); + ekOrderedList: + fListStack.Push(TListState.Create(ckNumbered)); + ekListItem: + begin + fListStack.IncTopListNumber; + case fListStack.Peek.ListKind of + ckBulleted: + NewContainer := TBulletListItem.Create( + fContainerStack.Peek.Depth + 1, fListStack.Peek.ListNumber + ); + ckNumbered: + NewContainer := TNumberListItem.Create( + fContainerStack.Peek.Depth + 1, fListStack.Peek.ListNumber + ); + else + raise EBug.Create( + ClassName + '.ParseBlockActionElem: Unknown list item type' + ); + end; + CurContainer.Add(NewContainer); + fContainerStack.Push(NewContainer); + end; + ekBlock: + CurContainer.Add(TSimpleBlock.Create(CurContainer.Depth)); + ekPara: + CurContainer.Add(TParaBlock.Create(CurContainer.Depth)); + ekHeading: + CurContainer.Add(THeadingBlock.Create(CurContainer.Depth)); + end; + end; + + fsClose: + begin + case Elem.Kind of + ekDocument: + ; // do nothing + ekUnorderedList, ekOrderedList: + fListStack.Pop; + ekListItem: + begin + fContainerStack.Pop; + CurContainer.Close; + end; + ekBlock, ekPara, ekHeading: + CurContainer.LastChunk.Close; + end; + end; + end; +end; + +procedure TActiveTextMarkdown.ParseInlineActionElem( + Elem: IActiveTextActionElem); +var + CurContainer: TContainer; + Block: TBlock; +begin + // Find last open block: create one if necessary + CurContainer := fContainerStack.Peek; + if not CurContainer.IsEmpty and (CurContainer.LastChunk is TBlock) + and not CurContainer.LastChunk.IsClosed then + Block := CurContainer.LastChunk as TBlock + else + begin + Block := TSimpleBlock.Create(CurContainer.Depth); + CurContainer.Add(Block); + end; + + case Elem.State of + fsOpen: + begin + + CurContainer := fContainerStack.Peek; + if not CurContainer.IsEmpty and (CurContainer.LastChunk is TBlock) + and not CurContainer.LastChunk.IsClosed then + Block := CurContainer.LastChunk as TBlock + else + begin + Block := TSimpleBlock.Create(CurContainer.Depth); + CurContainer.Add(Block); + end; + + case Elem.Kind of + + ekLink, ekStrong, ekWarning, ekEm, ekVar: + begin + Block.MarkdownStack.Push( + Block.LookupElemKind(Elem.Kind), + function (AKind: TInlineElemKind): Boolean + begin + Assert(AKind in [iekWeakEmphasis, iekStrongEmphasis, iekLink]); + Result := (Block.MarkdownStack.NestingDepthOf(AKind) = 0) + and not Block.MarkdownStack.IsOpen(iekInlineCode); + end, + Elem.Attrs + ); + end; + + ekMono: + Block.MarkdownStack.Push( + Block.LookupElemKind(Elem.Kind), + function (AKind: TInlineElemKind): Boolean + begin + Assert(AKind = iekInlineCode); + Result := Block.MarkdownStack.NestingDepthOf(AKind) = 0; + end, + Elem.Attrs + ); + end; + end; + + fsClose: + begin + CurContainer := fContainerStack.Peek; + Assert(not CurContainer.IsEmpty or not (CurContainer.LastChunk is TBlock)); + Block := CurContainer.LastChunk as TBlock; + CloseInlineElem(Block); + end; + end; +end; + +procedure TActiveTextMarkdown.ParseTextElem(Elem: IActiveTextTextElem); +var + CurContainer: TContainer; + Block: TBlock; +begin + CurContainer := fContainerStack.Peek; + if not CurContainer.IsEmpty and (CurContainer.LastChunk is TBlock) + and not CurContainer.LastChunk.IsClosed then + Block := CurContainer.LastChunk as TBlock + else + begin + Block := TSimpleBlock.Create(CurContainer.Depth); + CurContainer.Add(Block); + end; + if not Block.MarkdownStack.IsOpen(iekInlineCode) then + Block.MarkdownStack.AppendMarkdown(TMarkdown.EscapeText(Elem.Text)) + else + Block.MarkdownStack.AppendMarkdown(Elem.Text); +end; + +function TActiveTextMarkdown.Render(ActiveText: IActiveText): string; +var + Document: IStringList; +begin + Parse(ActiveText); + Assert(fContainerStack.Count = 1); + + Document := TIStringList.Create; + fContainerStack.Peek.Render(Document); + Result := Document.GetText(EOL, True); + while StrContainsStr(EOL2 + EOL, Result) do + Result := StrReplace(Result, EOL2 + EOL, EOL2); + Result := StrTrim(Result) + EOL; +end; + +{ TActiveTextMarkdown.TInlineElem } + +constructor TActiveTextMarkdown.TInlineElem.Create( + const AFormatterKind: TInlineElemKind; + const ACanRenderElem: TPredicate<TInlineElemKind>; + const AAttrs: IActiveTextAttrs); +begin + // Assign fields from parameters + fFormatterKind := AFormatterKind; + fMarkdown := ''; + fAttrs := AAttrs; + fCanRenderElem := ACanRenderElem; + + // Set defaults for nil fields + if not Assigned(AAttrs) then + fAttrs := TActiveTextFactory.CreateAttrs; + + if not Assigned(ACanRenderElem) then + fCanRenderElem := + function (AFmtKind: TInlineElemKind): Boolean + begin + Result := True; + end; +end; + +{ TActiveTextMarkdown.TInlineElemStack } + +procedure TActiveTextMarkdown.TInlineElemStack.AppendMarkdown( + const AMarkdown: string); +var + Elem: TInlineElem; +begin + Elem := Pop; + Elem.Markdown := Elem.Markdown + AMarkdown; + inherited Push(Elem); +end; + +constructor TActiveTextMarkdown.TInlineElemStack.Create; +begin + inherited Create; + // Push root element onto stack that receives all rendered markdown + // This element can always be rendered, has no attributes and no special chars + Push(iekPlain, nil, {nil, }nil); +end; + +destructor TActiveTextMarkdown.TInlineElemStack.Destroy; +begin + inherited; +end; + +function TActiveTextMarkdown.TInlineElemStack.IsEmpty: Boolean; +begin + Result := Count = 0; +end; + +function TActiveTextMarkdown.TInlineElemStack.IsOpen( + const AFmtKind: TInlineElemKind): Boolean; +var + Elem: TInlineElem; +begin + Result := False; + for Elem in Self do + if Elem.Kind = AFmtKind then + Exit(True); +end; + +function TActiveTextMarkdown.TInlineElemStack.NestingDepthOf( + const AFmtKind: TInlineElemKind): Integer; +var + Elem: TInlineElem; +begin + Result := -1; + for Elem in Self do + if (Elem.Kind = AFmtKind) then + Inc(Result); +end; + +procedure TActiveTextMarkdown.TInlineElemStack.Push( + const AFmtKind: TInlineElemKind; + const ACanRenderElem: TPredicate<TInlineElemKind>; + const AAttrs: IActiveTextAttrs); +begin + inherited Push( + TInlineElem.Create(AFmtKind, ACanRenderElem, AAttrs) + ); +end; + +{ TActiveTextMarkdown.TListState } + +constructor TActiveTextMarkdown.TListState.Create(AListKind: TContainerKind); +begin + ListKind := AListKind; + ListNumber := 0; +end; + +{ TActiveTextMarkdown.TListStack } + +constructor TActiveTextMarkdown.TListStack.Create; +begin + inherited Create; +end; + +destructor TActiveTextMarkdown.TListStack.Destroy; +begin + inherited; +end; + +procedure TActiveTextMarkdown.TListStack.IncTopListNumber; +var + State: TListState; +begin + State := Pop; + Inc(State.ListNumber); + Push(State); +end; + +{ TActiveTextMarkdown.TContentChunk } + +procedure TActiveTextMarkdown.TContentChunk.Close; +begin + fClosed := True; +end; + +constructor TActiveTextMarkdown.TContentChunk.Create(const ADepth: UInt8); +begin + inherited Create; + fDepth := ADepth; + fClosed := False; +end; + +function TActiveTextMarkdown.TContentChunk.IsClosed: Boolean; +begin + Result := fClosed; +end; + +{ TActiveTextMarkdown.TContainer } + +procedure TActiveTextMarkdown.TContainer.Add(const AChunk: TContentChunk); +begin + fContent.Add(AChunk); +end; + +function TActiveTextMarkdown.TContainer.Content: TArray<TContentChunk>; +begin + Result := fContent.ToArray; +end; + +constructor TActiveTextMarkdown.TContainer.Create(const ADepth: UInt8); +begin + inherited Create(ADepth); + fContent := TObjectList<TContentChunk>.Create(True); +end; + +destructor TActiveTextMarkdown.TContainer.Destroy; +begin + fContent.Free; + inherited; +end; + +function TActiveTextMarkdown.TContainer.IsEmpty: Boolean; +begin + Result := fContent.Count = 0; +end; + +function TActiveTextMarkdown.TContainer.LastChunk: TContentChunk; +begin + Result := fContent.Last; +end; + +function TActiveTextMarkdown.TContainer.TrimEmptyBlocks: TArray<TContentChunk>; +var + TrimmedBlocks: TList<TContentChunk>; + Chunk: TContentChunk; +begin + TrimmedBlocks := TList<TContentChunk>.Create; + try + for Chunk in fContent do + begin + if (Chunk is TBlock) then + begin + if not (Chunk as TBlock).IsEmpty then + TrimmedBlocks.Add(Chunk); + end + else + TrimmedBlocks.Add(Chunk); + end; + Result := TrimmedBlocks.ToArray; + finally + TrimmedBlocks.Free; + end; +end; + +{ TActiveTextMarkdown.TDocument } + +procedure TActiveTextMarkdown.TDocument.Render(const ALines: IStringList); +var + Chunk: TContentChunk; +begin + for Chunk in Self.TrimEmptyBlocks do + begin + Chunk.Render(ALines); + end; +end; + +{ TActiveTextMarkdown.TListItem } + +constructor TActiveTextMarkdown.TListItem.Create(const ADepth: UInt8; const ANumber: UInt8); +begin + inherited Create(ADepth); + fNumber := ANumber; +end; + +{ TActiveTextMarkdown.TBulletListItem } + +constructor TActiveTextMarkdown.TBulletListItem.Create(const ADepth: UInt8; const ANumber: UInt8); +begin + inherited Create(ADepth, ANumber); +end; + +procedure TActiveTextMarkdown.TBulletListItem.Render(const ALines: IStringList); +var + Idx: Integer; + StartIdx: Integer; + Trimmed: TArray<TContentChunk>; + ItemText: string; + + procedure AddBulletItem(const AMarkdown: string); + begin + ALines.Add(TMarkdown.BulletListItem(AMarkdown, Depth - 1)); + end; + +begin + Trimmed := TrimEmptyBlocks; + StartIdx := 0; + if Length(Trimmed) > 0 then + begin + if (Trimmed[0] is TBlock) then + begin + ItemText := (Trimmed[0] as TBlock).RenderStr; + if StrStartsStr(EOL, ItemText) then + ALines.Add(''); + AddBulletItem(StrTrimLeft(ItemText)); + Inc(StartIdx); + end + else + begin + AddBulletItem(''); + end; + for Idx := StartIdx to Pred(Length(Trimmed)) do + Trimmed[Idx].Render(ALines); + end + else + begin + AddBulletItem(''); + end; +end; + +{ TActiveTextMarkdown.TNumberListItem } + +constructor TActiveTextMarkdown.TNumberListItem.Create(const ADepth: UInt8; const ANumber: UInt8); +begin + inherited Create(ADepth, ANumber); +end; + +procedure TActiveTextMarkdown.TNumberListItem.Render(const ALines: IStringList); +var + Idx: Integer; + StartIdx: Integer; + Trimmed: TArray<TContentChunk>; + ItemText: string; + + procedure AddNumberItem(const AMarkdown: string); + begin + ALines.Add(TMarkdown.NumberListItem(AMarkdown, Number, Depth - 1)); + end; + +begin + Trimmed := TrimEmptyBlocks; + StartIdx := 0; + if Length(Trimmed) > 0 then + begin + if (Trimmed[0] is TBlock) then + begin + ItemText := (Trimmed[0] as TBlock).RenderStr; + if StrStartsStr(EOL, ItemText) then + ALines.Add(''); + AddNumberItem(StrTrimLeft(ItemText)); + Inc(StartIdx); + end + else + begin + AddNumberItem(''); + end; + for Idx := StartIdx to Pred(Length(Trimmed)) do + Trimmed[Idx].Render(ALines); + end + else + begin + AddNumberItem(''); + end; +end; + +{ TActiveTextMarkdown.TBlock } + +constructor TActiveTextMarkdown.TBlock.Create(const ADepth: UInt8); +begin + inherited Create(ADepth); + fMarkdownStack := TInlineElemStack.Create; +end; + +destructor TActiveTextMarkdown.TBlock.Destroy; +begin + fMarkdownStack.Free; + inherited; +end; + +function TActiveTextMarkdown.TBlock.IsEmpty: Boolean; +var + MDElem: TInlineElem; +begin + Result := True; + if fMarkdownStack.IsEmpty then + Exit; + for MDElem in fMarkdownStack do + if not StrIsEmpty(MDElem.Markdown, True) then + Exit(False); +end; + +function TActiveTextMarkdown.TBlock.LookupElemKind( + const AActiveTextKind: TActiveTextActionElemKind): TInlineElemKind; +begin + case AActiveTextKind of + ekLink: Result := iekLink; + ekStrong, ekWarning: Result := iekStrongEmphasis; + ekEm, ekVar: Result := iekWeakEmphasis; + ekMono: Result := iekInlineCode; + else + raise EBug.Create( + ClassName + '.LookupElemKind: Invalid inline active text element kind' + ); + end; +end; + +{ TActiveTextMarkdown.TSimpleBlock } + +procedure TActiveTextMarkdown.TSimpleBlock.Render(const ALines: IStringList); +begin + Assert(not MarkdownStack.IsEmpty); + ALines.Add(RenderStr); + ALines.Add(''); +end; + +function TActiveTextMarkdown.TSimpleBlock.RenderStr: string; +begin + Result := TMarkdown.Paragraph( + StrTrimLeft(MarkdownStack.Peek.Markdown), Depth + ); +end; + +{ TActiveTextMarkdown.TParaBlock } + +procedure TActiveTextMarkdown.TParaBlock.Render(const ALines: IStringList); +begin + Assert(not MarkdownStack.IsEmpty); + ALines.Add(RenderStr); +end; + +function TActiveTextMarkdown.TParaBlock.RenderStr: string; +begin + Result := EOL + TMarkdown.Paragraph( + StrTrimLeft(MarkdownStack.Peek.Markdown), Depth + ) + EOL; +end; + +{ TActiveTextMarkdown.THeadingBlock } + +procedure TActiveTextMarkdown.THeadingBlock.Render(const ALines: IStringList); +begin + Assert(not MarkdownStack.IsEmpty); + ALines.Add(RenderStr); +end; + +function TActiveTextMarkdown.THeadingBlock.RenderStr: string; +begin + Result := EOL + TMarkdown.Heading( + StrTrimLeft(MarkdownStack.Peek.Markdown), 2, Depth + ) + EOL; +end; + +end. + diff --git a/Src/ActiveText.URTFRenderer.pas b/Src/ActiveText.URTFRenderer.pas index 112142a51..216dcdf42 100644 --- a/Src/ActiveText.URTFRenderer.pas +++ b/Src/ActiveText.URTFRenderer.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a class and helpers that create RTF representations of active text * with customised styling. @@ -45,11 +45,34 @@ TActiveTextRTFStyleMap = class(TObject) type TActiveTextRTF = class(TObject) strict private + const + // Difference between indent levels in twips + IndentDelta = 360; + // RTF Bullet character + Bullet = #$2022; + type + TListKind = (lkNumber, lkBullet); + TListState = record + public + ListNumber: Cardinal; + ListKind: TListKind; + constructor Create(AListKind: TListKind); + end; + TLIState = record + IsFirstPara: Boolean; + Prefix: string; + constructor Create(AIsFirstPara: Boolean; const APrefix: string); + end; var fElemStyleMap: TActiveTextRTFStyleMap; fDisplayURLs: Boolean; fURLStyle: TRTFStyle; - fInBlock: Boolean; + fBlockStack: TStack<TActiveTextActionElemKind>; + fListStack: TStack<TListState>; + fIndentStack: TStack<SmallInt>; + fLIStack: TStack<TLIState>; + fIndentLevel: Byte; // logical indent level + fInPara: Boolean; procedure SetElemStyleMap(const ElemStyleMap: TActiveTextRTFStyleMap); procedure Initialise(const Builder: TRTFBuilder); procedure RenderTextElem(Elem: IActiveTextTextElem; @@ -60,6 +83,7 @@ TActiveTextRTF = class(TObject) const Builder: TRTFBuilder); procedure RenderURL(Elem: IActiveTextActionElem; const Builder: TRTFBuilder); + function CanEmitInline: Boolean; public constructor Create; destructor Destroy; override; @@ -76,8 +100,10 @@ implementation uses + // Delphi + SysUtils, Generics.Defaults, // Project - SysUtils, Generics.Defaults; + UConsts, UStrUtils; { TActiveTextRTFStyleMap } @@ -155,15 +181,32 @@ procedure TActiveTextRTFStyleMap.MakeMonochrome; { TActiveTextRTF } +function TActiveTextRTF.CanEmitInline: Boolean; +begin + if fBlockStack.Count <= 0 then + Exit(False); + Result := TActiveTextElemCaps.CanContainText(fBlockStack.Peek); +end; + constructor TActiveTextRTF.Create; begin inherited Create; fElemStyleMap := TActiveTextRTFStyleMap.Create; fURLStyle := TRTFStyle.CreateNull; + fBlockStack := TStack<TActiveTextActionElemKind>.Create; + fListStack := TStack<TListState>.Create; + fIndentStack := TStack<SmallInt>.Create; + fLIStack := TStack<TLIState>.Create; + fIndentLevel := 0; + fInPara := False; end; destructor TActiveTextRTF.Destroy; begin + fLIStack.Free; + fIndentStack.Free; + fListStack.Free; + fBlockStack.Free; fElemStyleMap.Free; inherited; end; @@ -189,14 +232,13 @@ procedure TActiveTextRTF.Render(ActiveText: IActiveText; ActionElem: IActiveTextActionElem; begin Initialise(RTFBuilder); - fInBlock := False; for Elem in ActiveText do begin if Supports(Elem, IActiveTextTextElem, TextElem) then RenderTextElem(TextElem, RTFBuilder) else if Supports(Elem, IActiveTextActionElem, ActionElem) then begin - if ActionElem.DisplayStyle = dsBlock then + if TActiveTextElemCaps.DisplayStyleOf(ActionElem.Kind) = dsBlock then RenderBlockActionElem(ActionElem, RTFBuilder) else RenderInlineActionElem(ActionElem, RTFBuilder); @@ -206,19 +248,146 @@ procedure TActiveTextRTF.Render(ActiveText: IActiveText; procedure TActiveTextRTF.RenderBlockActionElem(Elem: IActiveTextActionElem; const Builder: TRTFBuilder); + + procedure OpenListContainer(const ListKind: TListKind); + begin + fListStack.Push(TListState.Create(ListKind)); + Inc(fIndentLevel); + Builder.BeginGroup; + end; + + function IndentTwips: SmallInt; + begin + Result := fElemStyleMap[ekListItem].IndentLevelToTwips(fIndentLevel) + end; + +var + ListState: TListState; + LIState: TLIState; + Style: TRTFStyle; begin case Elem.State of fsOpen: begin - fInBlock := True; - Builder.BeginGroup; - Builder.ApplyStyle(fElemStyleMap[Elem.Kind]); + fInPara := False; + fBlockStack.Push(Elem.Kind); + case Elem.Kind of + ekPara, ekHeading, ekBlock: + begin + Builder.BeginGroup; + Style := fElemStyleMap[Elem.Kind]; + if fLIStack.Count > 0 then + begin + Builder.SetTabStops([IndentTwips]); + if fLIStack.Peek.IsFirstPara then + begin + Builder.SetIndents( + IndentTwips, -fElemStyleMap[ekListItem].IndentDelta + ); + if (fListStack.Count > 0) then + begin + if fListStack.Peek.ListNumber = 1 then + begin + Style.Capabilities := Style.Capabilities + [scParaSpacing]; + if fListStack.Peek.ListKind = lkNumber then + Style.ParaSpacing := TRTFParaSpacing.Create( + fElemStyleMap[ekOrderedList].ParaSpacing.Before, 0.0 + ) + else + Style.ParaSpacing := TRTFParaSpacing.Create( + fElemStyleMap[ekUnorderedList].ParaSpacing.Before, 0.0 + ) + end + else if fListStack.Peek.ListNumber > 1 then + begin + if Elem.Kind = ekHeading then + begin + Style.Capabilities := Style.Capabilities + [scParaSpacing]; + Style.ParaSpacing := fElemStyleMap[ekPara].ParaSpacing; + end; + end; + end; + Builder.ApplyStyle(Style); + Builder.AddText(fLIStack.Peek.Prefix); + Builder.AddText(TAB); + fInPara := True; + end + else + begin + Builder.ApplyStyle(Style); + Builder.SetIndents(IndentTwips, 0); + end; + end + else + begin + Builder.ApplyStyle(Style); + Builder.SetIndents(IndentTwips, 0); + end; + end; + ekUnorderedList: + OpenListContainer(lkBullet); + ekOrderedList: + OpenListContainer(lkNumber); + ekListItem: + begin + // Update list number of current list + ListState := fListStack.Pop; + Inc(ListState.ListNumber, 1); + fListStack.Push(ListState); + Builder.BeginGroup; + Builder.ApplyStyle(fElemStyleMap[Elem.Kind]); + case fListStack.Peek.ListKind of + lkNumber: + begin + fLIStack.Push( + TLIState.Create( + True, IntToStr(fListStack.Peek.ListNumber) + '.' + ) + ); + end; + lkBullet: + begin + fLIStack.Push(TLIState.Create(True, Bullet)); + end; + end; + Builder.ClearParaFormatting; + end; + end; end; fsClose: begin - Builder.EndPara; - Builder.EndGroup; - fInBlock := False; + case Elem.Kind of + ekPara, ekHeading, ekBlock: + begin + if (fLIStack.Count > 0) and (fLIStack.Peek.IsFirstPara) then + begin + // Update item at top of LI stack to record not first para + LIState := fLIStack.Pop; + LIState.IsFirstPara := False; + fLIStack.Push(LIState); + end; + if fInPara then + Builder.EndPara; + Builder.EndGroup; + end; + ekUnorderedList, ekOrderedList: + begin + if fInPara then + Builder.EndPara; + Builder.EndGroup; + fListStack.Pop; + Dec(fIndentLevel); + end; + ekListItem: + begin + if fInPara then + Builder.EndPara; + Builder.EndGroup; + fLIStack.Pop; + end; + end; + fBlockStack.Pop; + fInPara := False; end; end; end; @@ -226,7 +395,7 @@ procedure TActiveTextRTF.RenderBlockActionElem(Elem: IActiveTextActionElem; procedure TActiveTextRTF.RenderInlineActionElem(Elem: IActiveTextActionElem; const Builder: TRTFBuilder); begin - if not fInBlock then + if not CanEmitInline then Exit; case Elem.State of fsOpen: @@ -245,10 +414,20 @@ procedure TActiveTextRTF.RenderInlineActionElem(Elem: IActiveTextActionElem; procedure TActiveTextRTF.RenderTextElem(Elem: IActiveTextTextElem; const Builder: TRTFBuilder); +var + TheText: string; begin - if not fInBlock then + if not CanEmitInline then Exit; - Builder.AddText(Elem.Text); + TheText := Elem.Text; + // no white space emitted after block start until 1st non-white space + // character encountered + if not fInPara then + TheText := StrTrimLeft(Elem.Text); + if TheText = '' then + Exit; + Builder.AddText(TheText); + fInPara := True; end; procedure TActiveTextRTF.RenderURL(Elem: IActiveTextActionElem; @@ -271,5 +450,22 @@ procedure TActiveTextRTF.SetElemStyleMap( fElemStyleMap.Assign(ElemStyleMap); end; +{ TActiveTextRTF.TListState } + +constructor TActiveTextRTF.TListState.Create(AListKind: TListKind); +begin + ListNumber := 0; + ListKind := AListKind; +end; + +{ TActiveTextRTF.TLIState } + +constructor TActiveTextRTF.TLIState.Create(AIsFirstPara: Boolean; + const APrefix: string); +begin + IsFirstPara := AIsFirstPara; + Prefix := APrefix; +end; + end. diff --git a/Src/ActiveText.UTextRenderer.pas b/Src/ActiveText.UTextRenderer.pas index 5ac62c25c..eaec317ff 100644 --- a/Src/ActiveText.UTextRenderer.pas +++ b/Src/ActiveText.UTextRenderer.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements class that renders active text as plain text in fixed width, word * wrapped paragraphs. @@ -15,17 +15,52 @@ interface uses - SysUtils, - ActiveText.UMain; + SysUtils, Generics.Collections, + ActiveText.UMain, + UConsts; type TActiveTextTextRenderer = class(TObject) strict private + const + /// <summary>Special space character used to indicate the start of a list + /// item.</summary> + /// <remarks>This special character is a necessary kludge because some + /// code that renders active text as formatted plain text strips away + /// leading #32 characters as part of the formatting process. Therefore + /// indentation in list items is lost if #32 characters are used for it. + /// NBSP was chosen since it should render the same as a space if not + /// removed.</remarks> + LISpacer = NBSP; // Do not localise. Must be <> #32 + /// <summary>Bullet character used when rendering unordered list items. + /// </summary> + Bullet = '*'; // Do not localise. Must be <> #32 and <> LISpacer + DefaultIndentDelta = 2; + type + TListKind = (lkNumber, lkBullet); + TListState = record + public + ListNumber: Cardinal; + ListKind: TListKind; + constructor Create(AListKind: TListKind); + end; + TLIState = record + IsFirstPara: Boolean; + constructor Create(AIsFirstPara: Boolean); + end; var fDisplayURLs: Boolean; - fInBlock: Boolean; fParaBuilder: TStringBuilder; fDocBuilder: TStringBuilder; + fBlocksStack: TStack<TActiveTextActionElemKind>; + fListStack: TStack<TListState>; + fLIStack: TStack<TLIState>; + fIndent: UInt16; + fInPara: Boolean; + fInListItem: Boolean; + fIndentDelta: UInt8; + function CanEmitInline: Boolean; + procedure AppendToPara(const AText: string); procedure InitialiseRender; procedure FinaliseRender; procedure OutputParagraph; @@ -33,32 +68,68 @@ TActiveTextTextRenderer = class(TObject) procedure RenderBlockActionElem(Elem: IActiveTextActionElem); procedure RenderInlineActionElem(Elem: IActiveTextActionElem); procedure RenderURL(Elem: IActiveTextActionElem); + function Render(ActiveText: IActiveText): string; public constructor Create; destructor Destroy; override; property DisplayURLs: Boolean read fDisplayURLs write fDisplayURLs default False; - function Render(ActiveText: IActiveText): string; + property IndentDelta: UInt8 read fIndentDelta write fIndentDelta + default DefaultIndentDelta; + function RenderWrapped(ActiveText: IActiveText; const PageWidth, + LMargin: Cardinal): string; end; implementation uses + // Delphi + Character, + // Project + UIStringList, UStrUtils; { TActiveTextTextRenderer } +procedure TActiveTextTextRenderer.AppendToPara(const AText: string); +begin + if AText = '' then + Exit; + fParaBuilder.Append(AText); + fInPara := True; +end; + +function TActiveTextTextRenderer.CanEmitInline: Boolean; +begin + if fBlocksStack.Count <= 0 then + Exit(False); + Result := TActiveTextElemCaps.CanContainText(fBlocksStack.Peek); +end; + constructor TActiveTextTextRenderer.Create; begin + Assert(LISpacer <> ' ', ClassName + '.Create: LISpacer can''t be #32'); + Assert(Bullet <> ' ', ClassName + '.Create: Bullet can''t be #32'); + Assert(Bullet <> LISpacer, ClassName + '.Create: Bullet = LISpacer'); inherited Create; fParaBuilder := TStringBuilder.Create; fDocBuilder := TStringBuilder.Create; fDisplayURLs := False; + fBlocksStack := TStack<TActiveTextActionElemKind>.Create; + fListStack := TStack<TListState>.Create; + fLIStack := TStack<TLIState>.Create; + fIndent := 0; + fInPara := False; + fInListItem := False; + fIndentDelta := DefaultIndentDelta; end; destructor TActiveTextTextRenderer.Destroy; begin + fLIStack.Free; + fListStack.Free; + fBlocksStack.Free; fDocBuilder.Free; fParaBuilder.Free; inherited; @@ -76,11 +147,33 @@ procedure TActiveTextTextRenderer.InitialiseRender; end; procedure TActiveTextTextRenderer.OutputParagraph; +var + LIState: TLIState; begin if fParaBuilder.Length = 0 then Exit; - fDocBuilder.AppendLine(StrTrim(fParaBuilder.ToString)); + fDocBuilder.Append(StrOfChar(NBSP, fIndent)); + if fInListItem and not fLIStack.Peek.IsFirstPara then + // Do we need fInListItem? - test for non-empty list stack? + // if we do need it, put it on list stack + fDocBuilder.Append(StrOfChar(NBSP, IndentDelta)); + if fLIStack.Count > 0 then + begin + if not fLIStack.Peek.IsFirstPara then + begin + fDocBuilder.Append(StrOfChar(NBSP, IndentDelta)); + end + else + begin + // Update item at top of stack + LIState := fLIStack.Pop; + LIState.IsFirstPara := False; + fLIStack.Push(LIState); + end; + end; + fDocBuilder.AppendLine(StrTrimRight(fParaBuilder.ToString)); fParaBuilder.Clear; + fInPara := False; end; function TActiveTextTextRenderer.Render(ActiveText: IActiveText): string; @@ -90,14 +183,13 @@ function TActiveTextTextRenderer.Render(ActiveText: IActiveText): string; ActionElem: IActiveTextActionElem; begin InitialiseRender; - fInBlock := False; for Elem in ActiveText do begin if Supports(Elem, IActiveTextTextElem, TextElem) then RenderTextElem(TextElem) else if Supports(Elem, IActiveTextActionElem, ActionElem) then begin - if ActionElem.DisplayStyle = dsBlock then + if TActiveTextElemCaps.DisplayStyleOf(ActionElem.Kind) = dsBlock then RenderBlockActionElem(ActionElem) else RenderInlineActionElem(ActionElem); @@ -109,16 +201,72 @@ function TActiveTextTextRenderer.Render(ActiveText: IActiveText): string; procedure TActiveTextTextRenderer.RenderBlockActionElem( Elem: IActiveTextActionElem); + + procedure OpenListContainer(const ListKind: TListKind); + begin + if (fListStack.Count > 0) and (fInPara) then + OutputParagraph; + fListStack.Push(TListState.Create(ListKind)); + Inc(fIndent, IndentDelta); + end; + + procedure AddListMarker(const Marker: string); + begin + fParaBuilder.Append(Marker); + fParaBuilder.Append(StringOfChar(NBSP, IndentDelta - Length(Marker))); + end; + +var + ListState: TListState; begin case Elem.State of fsOpen: begin - fInBlock := True; + fBlocksStack.Push(Elem.Kind); + case Elem.Kind of + ekPara, ekHeading, ekBlock: + {Do nothing} ; + ekUnorderedList: + OpenListContainer(lkBullet); + ekOrderedList: + OpenListContainer(lkNumber); + ekListItem: + begin + // Update list number of current list + ListState := fListStack.Pop; + Inc(ListState.ListNumber, 1); + fListStack.Push(ListState); + // Push this list item to list item stack + fLIStack.Push(TLIState.Create(True)); + // Act depending on current list kind + case fListStack.Peek.ListKind of + lkNumber: + AddListMarker(IntToStr(fListStack.Peek.ListNumber)); + lkBullet: + AddListMarker(Bullet); + end; + end; + end; end; fsClose: begin - OutputParagraph; - fInBlock := False; + case Elem.Kind of + ekPara, ekHeading, ekBlock: + OutputParagraph; + ekUnorderedList, ekOrderedList: + begin + OutputParagraph; + fListStack.Pop; + Dec(fIndent, IndentDelta); + end; + ekListItem: + begin + OutputParagraph; + fInListItem := False; + fLIStack.Pop; + end; + end; + fBlocksStack.Pop; end; end; end; @@ -126,17 +274,27 @@ procedure TActiveTextTextRenderer.RenderBlockActionElem( procedure TActiveTextTextRenderer.RenderInlineActionElem( Elem: IActiveTextActionElem); begin - if not fInBlock then + if not CanEmitInline then Exit; if (Elem.Kind = ekLink) and (Elem.State = fsClose) and fDisplayURLs then RenderURL(Elem); + // else ignore element: formatting elements have no effect on plain text end; procedure TActiveTextTextRenderer.RenderTextElem(Elem: IActiveTextTextElem); +var + TheText: string; begin - if not fInBlock then + if not CanEmitInline then + Exit; + TheText := Elem.Text; + // no white space emitted after block start until 1st non-white space + // character encountered + if not fInPara then + TheText := StrTrimLeft(Elem.Text); + if TheText = '' then Exit; - fParaBuilder.Append(Elem.Text); + AppendToPara(TheText); end; procedure TActiveTextTextRenderer.RenderURL(Elem: IActiveTextActionElem); @@ -144,7 +302,101 @@ procedure TActiveTextTextRenderer.RenderURL(Elem: IActiveTextActionElem); sURL = ' (%s)'; // formatting for URLs from hyperlinks begin Assert(Elem.Kind = ekLink, ClassName + '.RenderURL: Not a link element'); - fParaBuilder.AppendFormat(sURL, [Elem.Attrs[TActiveTextAttrNames.Link_URL]]); + AppendToPara(Format(sURL, [Elem.Attrs[TActiveTextAttrNames.Link_URL]])); +end; + +function TActiveTextTextRenderer.RenderWrapped(ActiveText: IActiveText; + const PageWidth, LMargin: Cardinal): + string; +var + Paras: IStringList; + Para: string; + ParaIndent: UInt16; + WrappedPara: string; + Offset: Int16; + + // Calculate indent of paragraph by counting LISpacer characters inserted by + // Render method + function CalcParaIndent: UInt16; + var + Ch: Char; + begin + Result := 0; + for Ch in Para do + begin + if Ch <> LISpacer then + Break; + Inc(Result); + end; + end; + + // Calculate if we are currently processing a list item by detecting Bullet, + // digits and LISpacer characters inserted by Render method + function IsListItem: Boolean; + var + Remainder: string; + Digits: string; + Ch: Char; + begin + Result := False; + // Strip any leading spacer chars from start of para + Remainder := StrTrimLeftChars(Para, LISpacer); + // Check for bullet list: starts with bullet character then spacer + if StrStartsStr(Bullet + LISpacer, Remainder) then + Exit(True); + // Check for number list: starts with digit(s) then spacer + Digits := ''; + for Ch in Remainder do + if TCharacter.IsDigit(Ch) then + Digits := Digits + Ch + else + Break; + if (Digits <> '') and + StrStartsStr(Digits + LISpacer, Remainder) then + Exit(True); + end; + +begin + Result := ''; + Paras := TIStringList.Create(Render(ActiveText), EOL, True); + for Para in Paras do + begin + if IsListItem then + begin + Offset := -IndentDelta; + ParaIndent := CalcParaIndent + LMargin + IndentDelta; + end + else + begin + Offset := 0; + ParaIndent := CalcParaIndent + LMargin; + end; + WrappedPara := StrWrap( + StrReplace(Para, LISpacer, ' '), + PageWidth - ParaIndent, + ParaIndent, + Offset + ); + if Result <> '' then + Result := Result + EOL; + Result := Result + StrTrimRight(WrappedPara); + end; + Result := StrTrimRight(Result); +end; + +{ TActiveTextTextRenderer.TListState } + +constructor TActiveTextTextRenderer.TListState.Create(AListKind: TListKind); +begin + ListNumber := 0; + ListKind := AListKind; +end; + +{ TActiveTextTextRenderer.TLIState } + +constructor TActiveTextTextRenderer.TLIState.Create(AIsFirstPara: Boolean); +begin + IsFirstPara := AIsFirstPara; end; end. diff --git a/Src/ActiveText.UValidator.pas b/Src/ActiveText.UValidator.pas index cac3dd714..8cc68143c 100644 --- a/Src/ActiveText.UValidator.pas +++ b/Src/ActiveText.UValidator.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a container record that provides methods to validate active text * object. @@ -36,16 +36,11 @@ TErrorInfo = record public /// <summary>Error code.</summary> Code: TErrorCode; - /// <summary>Reference to element causing problem.</summary> - /// <remarks>May be nil if error doesn't relate to an element. - /// </remarks> - Element: IActiveTextElem; /// <summary>Description of error.</summary> Description: string; /// <summary>Constructs a record. Sets fields from parameter values. /// </summary> - constructor Create(const ACode: TErrorCode; AElement: IActiveTextElem; - const ADescription: string); overload; + constructor Create(const ACode: TErrorCode; const ADescription: string); end; strict private /// <summary>Validates given link element.</summary> @@ -56,6 +51,14 @@ TErrorInfo = record /// <returns>Boolean. True on success or False on failure.</returns> class function ValidateLink(LinkElem: IActiveTextActionElem; out ErrInfo: TErrorInfo): Boolean; static; + /// <summary>Validates document structure.</summary> + /// <param name="ActiveText">IActiveText [in] Active text to be validated. + /// </param> + /// <param name="ErrInfo">TErrorInfo [out] Contains error information if + /// validation fails. Undefined if validation succeeds.</param> + /// <returns>Boolean. True on success or False on failure.</returns> + class function ValidateDocumentStructure(ActiveText: IActiveText; + out ErrInfo: TErrorInfo): Boolean; static; public /// <summary>Validates given active text.</summary> /// <param name="ActiveText">IActiveText [in] Active text to be validated. @@ -92,6 +95,9 @@ class function TActiveTextValidator.Validate(ActiveText: IActiveText; begin if ActiveText.IsEmpty then Exit(True); + // Validate document structure + if not ValidateDocumentStructure(ActiveText, ErrInfo) then + Exit(False); // Validate elements for Elem in ActiveText do begin @@ -115,6 +121,16 @@ class function TActiveTextValidator.Validate(ActiveText: IActiveText): Boolean; Result := Validate(ActiveText, Dummy); end; +class function TActiveTextValidator.ValidateDocumentStructure( + ActiveText: IActiveText; out ErrInfo: TErrorInfo): Boolean; +resourcestring + sNoDocTags = 'Document must start and end with document tags'; +begin + Result := ActiveText.IsValidActiveTextDocument; + if not Result then + ErrInfo := TErrorInfo.Create(errBadStructure, sNoDocTags); +end; + class function TActiveTextValidator.ValidateLink( LinkElem: IActiveTextActionElem; out ErrInfo: TErrorInfo): Boolean; resourcestring @@ -150,7 +166,7 @@ TProtocolInfo = record < Length(PI.Protocol) + PI.MinURLLength then begin ErrInfo := TErrorInfo.Create( - errBadLinkURL, LinkElem, Format(sURLLengthErr, [URL]) + errBadLinkURL, Format(sURLLengthErr, [URL]) ); Exit(False); end; @@ -160,17 +176,16 @@ TProtocolInfo = record // No supported protocol Result := False; ErrInfo := TErrorInfo.Create( - errBadLinkProtocol, LinkElem, Format(sURLProtocolErr, [URL]) + errBadLinkProtocol, Format(sURLProtocolErr, [URL]) ); end; { TActiveTextValidator.TErrorInfo } constructor TActiveTextValidator.TErrorInfo.Create(const ACode: TErrorCode; - AElement: IActiveTextElem; const ADescription: string); + const ADescription: string); begin Code := ACode; - Element := AElement; Description := ADescription; end; diff --git a/Src/AutoGen/LICENSE b/Src/AutoGen/LICENSE deleted file mode 100644 index 3bf73d21e..000000000 --- a/Src/AutoGen/LICENSE +++ /dev/null @@ -1,7 +0,0 @@ -Files in the Src/AutoGen directory are auto-generated from other files and are -governed by the licenses that pertain to those files. - -For a list of such files see ReadMe.txt in this directory. - -The ReadMe.txt file itself has any copyright dedicated to the Public Domain. -http://creativecommons.org/publicdomain/zero/1.0/ \ No newline at end of file diff --git a/Src/Browser.IntfDocHostUI.pas b/Src/Browser.IntfDocHostUI.pas index a7cbb1e5d..25d84c217 100644 --- a/Src/Browser.IntfDocHostUI.pas +++ b/Src/Browser.IntfDocHostUI.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Interfaces, records and constants used when hosting the IE WebBrowser Control * or automating IE to replace the menus, toolbars, and context menus. The diff --git a/Src/Browser.UControlHelper.pas b/Src/Browser.UControlHelper.pas index ca49252b8..3f6fdfa4d 100644 --- a/Src/Browser.UControlHelper.pas +++ b/Src/Browser.UControlHelper.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines a static class that provides helper methods for manipulating and * interogating web browser controls. diff --git a/Src/Browser.UController.pas b/Src/Browser.UController.pas index da877a062..375d8cf90 100644 --- a/Src/Browser.UController.pas +++ b/Src/Browser.UController.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Class that hosts the IE web browser control and enables both direct loading * and saving of browser's HTML and customisation of the user interface. Much of diff --git a/Src/Browser.UHTMLEvents.pas b/Src/Browser.UHTMLEvents.pas index 7cee7ceec..3096db404 100644 --- a/Src/Browser.UHTMLEvents.pas +++ b/Src/Browser.UHTMLEvents.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2021, Peter Johnson (gravatar.com/delphidabbler). * * Provides sinks for events triggered by HTML documents loaded in a TWebBrowser * control. Sinks for the HTMLDocumentEvents2 and HTMLWindowEvents2 diff --git a/Src/Browser.UHighlighter.pas b/Src/Browser.UHighlighter.pas index 69d323411..68f2ac0e2 100644 --- a/Src/Browser.UHighlighter.pas +++ b/Src/Browser.UHighlighter.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * Class that highlights text in web browser that match a search criteria. } @@ -194,7 +194,7 @@ function TWBHighlighter.HighlightWord(const Word: string; begin // Apply highlight to found text by spanning it with highlight style SpanAttrs := THTMLAttributes.Create('style', fHighLightStyle); - Range.pasteHTML(THTML.CompoundTag('span', SpanAttrs, Range.htmlText)); + Range.pasteHTML(TXHTML.CompoundTag('span', SpanAttrs, Range.htmlText)); Inc(Result); end else diff --git a/Src/Browser.UIOMgr.pas b/Src/Browser.UIOMgr.pas index 367ebdc4a..e9839d37b 100644 --- a/Src/Browser.UIOMgr.pas +++ b/Src/Browser.UIOMgr.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Class that wraps the IE web browser control and provides ability to load and * save HTML from files, streams or strings. Also simplifies navigation to @@ -187,7 +187,6 @@ procedure TWBIOMgr.DocCompleteHandler(Sender: TObject; const pDisp: IDispatch; begin // Top level document has finished loading iff pDisp contains reference to // browser control's default interface. - // See http://support.microsoft.com/kb/180366 if pDisp = (fWB.DefaultInterface as IDispatch) then fDocLoaded := True; end; diff --git a/Src/Browser.UNulUIHandler.pas b/Src/Browser.UNulUIHandler.pas index df597dd8c..b7a6794c0 100644 --- a/Src/Browser.UNulUIHandler.pas +++ b/Src/Browser.UNulUIHandler.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines a class that provides a "do-nothing" implementation of the * IDocHostUIHandler interface. All methods are "stubbed out" to return values diff --git a/Src/Browser.UUIMgr.pas b/Src/Browser.UUIMgr.pas index d7b62dc04..5ee8189c8 100644 --- a/Src/Browser.UUIMgr.pas +++ b/Src/Browser.UUIMgr.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Contains class that implements IDocHostUIHandler interface and allows * customisation of IE web browser control's user interface, message diff --git a/Src/ClassHelpers.RichEdit.pas b/Src/ClassHelpers.RichEdit.pas new file mode 100644 index 000000000..f82600e6f --- /dev/null +++ b/Src/ClassHelpers.RichEdit.pas @@ -0,0 +1,53 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2025, Peter Johnson (gravatar.com/delphidabbler). + * + * Class helper for TRichEdit. +} + +unit ClassHelpers.RichEdit; + +interface + +uses + // Delphi + ComCtrls, + // Project + URTFUtils; + +type + TRichEditHelper = class helper for TRichEdit + public + procedure Load(const ARTFMarkup: TRTFMarkup); + end; + +implementation + +uses + // Delphi + SysUtils, + Classes; + +{ TRichEditHelper } + +procedure TRichEditHelper.Load(const ARTFMarkup: TRTFMarkup); +var + Stream: TStream; +begin + PlainText := False; + Stream := TMemoryStream.Create; + try + ARTFMarkup.ToStream(Stream); + Stream.Position := 0; + // must set MaxLength or long documents may not display + MaxLength := Stream.Size; + Lines.LoadFromStream(Stream, TEncoding.ASCII); + finally + Stream.Free; + end; +end; + +end. diff --git a/Src/ClassHelpers.UActions.pas b/Src/ClassHelpers.UActions.pas new file mode 100644 index 000000000..d37881ac7 --- /dev/null +++ b/Src/ClassHelpers.UActions.pas @@ -0,0 +1,43 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2012-2024, Peter Johnson (gravatar.com/delphidabbler). + * + * Class helper for TCustomActionList + * + * Extracted in 2024 from original UClassHelpers unit (2012-2021) +} + +unit ClassHelpers.UActions; + +interface + +uses + // Delphi + ActnList; + +type + /// <summary>Class helper that adds a method to TCustomActionList that can + /// update all the actions in the list.</summary> + TActionListHelper = class helper for TCustomActionList + public + /// <summary>Updates all actions in the action list by calling their Update + /// methods.</summary> + procedure Update; + end; + +implementation + +{ TActionListHelper } + +procedure TActionListHelper.Update; +var + Action: TContainedAction; // each action in list +begin + for Action in Self do + Action.Update; +end; + +end. diff --git a/Src/ClassHelpers.UControls.pas b/Src/ClassHelpers.UControls.pas new file mode 100644 index 000000000..2ea885ee0 --- /dev/null +++ b/Src/ClassHelpers.UControls.pas @@ -0,0 +1,68 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2012-2024, Peter Johnson (gravatar.com/delphidabbler). + * + * Class helper for TControl. + * + * Extracted in 2024 from original UClassHelpers unit (2012-2021). +} + +unit ClassHelpers.UControls; + +interface + +uses + // Delphi + Controls, Menus; + +type + /// <summary>Class helper that adds functionality to TControl.</summary> + TControlHelper = class helper for TControl + public + /// <summary>Gets reference to pop-up menu assigned to protected PopupMenu + /// property.</summary> + function GetPopupMenu: TPopupMenu; + /// <summary>Checks if protected PopupMenu property is assigned.</summary> + function HasPopupMenu: Boolean; + /// <summary>Refreshes control's action. Any changes in action that affect + /// state of control are reflected in control.</summary> + procedure RefreshAction; + /// <summary>Refreshes all owned controls to reflect any changes in their + /// associated actions.</summary> + procedure RefreshActions; + end; + +implementation + +{ TControlHelper } + +function TControlHelper.GetPopupMenu: TPopupMenu; +begin + Result := PopupMenu; +end; + +function TControlHelper.HasPopupMenu: Boolean; +begin + Result := Assigned(PopupMenu); +end; + +procedure TControlHelper.RefreshAction; +begin + if Assigned(Action) then + ActionChange(Action, False); +end; + +procedure TControlHelper.RefreshActions; +var + Idx: Integer; // loops through all controls +begin + for Idx := 0 to Pred(ComponentCount) do + if Components[Idx] is TControl then + (Components[Idx] as TControl).RefreshAction; +end; + +end. + diff --git a/Src/UClassHelpers.pas b/Src/ClassHelpers.UGraphics.pas similarity index 62% rename from Src/UClassHelpers.pas rename to Src/ClassHelpers.UGraphics.pas index 99d504d02..d63866cc6 100644 --- a/Src/UClassHelpers.pas +++ b/Src/ClassHelpers.UGraphics.pas @@ -1,41 +1,22 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2024, Peter Johnson (gravatar.com/delphidabbler). * - * Provides various class helpers for VCL classes. + * Provides class helpers for VCL image classes. + * + * Extracted from in 2024 original UClassHelpers unit (2012-2021). } - -unit UClassHelpers; - +unit ClassHelpers.UGraphics; interface - uses // Delphi - Controls, Menus, ImgList, Graphics, ActnList; - - -type - /// <summary>Class helper that adds functionality to TControl.</summary> - TControlHelper = class helper for TControl - public - /// <summary>Gets reference to pop-up menu assigned to protected PopupMenu - /// property.</summary> - function GetPopupMenu: TPopupMenu; - /// <summary>Checks if protected PopupMenu property is assigned.</summary> - function HasPopupMenu: Boolean; - /// <summary>Refreshes control's action. Any changes in action that affect - /// state of control are reflected in control.</summary> - procedure RefreshAction; - /// <summary>Refreshes all owned controls to reflect any changes in their - /// associated actions.</summary> - procedure RefreshActions; - end; + ImgList, Graphics, GIFImg; type /// <summary>Class helper that adds a method to TCustomImageList that can @@ -61,51 +42,26 @@ TImageListHelper = class helper for TCustomImageList end; type - /// <summary>Class helper that adds a method to TCustomActionList that can - /// update all the actions in the list.</summary> - TActionListHelper = class helper for TCustomActionList + /// <summary>Class helper that adds a method to TGIFImage that adds a similar + /// method to one present in 3rd party TGIFImage to load an image from + /// resources.</summary> + TGIFImageHelper = class helper for TGIFImage public - /// <summary>Updates all actions in the action list by calling their Update - /// methods.</summary> - procedure Update; + /// <summary>Load a GIF image from given resource.</summary> + /// <param name="Module">HINSTANCE [in] Module containing resource.</param> + /// <param name="ResName">string [in] Name of resource to be loaded. + /// </param> + /// <param name="ResType">PChar [in] Type of resource to be loaded.</param> + procedure LoadFromResource(const Module: HMODULE; const ResName: string; + const ResType: PChar); end; - implementation - uses // Delphi Classes; - -{ TControlHelper } - -function TControlHelper.GetPopupMenu: TPopupMenu; -begin - Result := PopupMenu; -end; - -function TControlHelper.HasPopupMenu: Boolean; -begin - Result := Assigned(PopupMenu); -end; - -procedure TControlHelper.RefreshAction; -begin - if Assigned(Action) then - ActionChange(Action, False); -end; - -procedure TControlHelper.RefreshActions; -var - Idx: Integer; // loops through all controls -begin - for Idx := 0 to Pred(ComponentCount) do - if Components[Idx] is TControl then - (Components[Idx] as TControl).RefreshAction; -end; - { TImageListHelper } procedure TImageListHelper.LoadFromResource(ResType: PChar; @@ -164,15 +120,19 @@ procedure TImageListHelper.LoadFromResource(ResType: PChar; end; end; -{ TActionListHelper } +{ TGIFImageHelper } -procedure TActionListHelper.Update; +procedure TGIFImageHelper.LoadFromResource(const Module: HMODULE; + const ResName: string; const ResType: PChar); var - Action: TContainedAction; // each action in list + Stm: TResourceStream; begin - for Action in Self do - Action.Update; + Stm := TResourceStream.Create(Module, ResName, ResType); + try + LoadFromStream(Stm); + finally + Stm.Free; + end; end; end. - diff --git a/Src/CodeSnip.cfg.tplt b/Src/CodeSnip.cfg.tplt index b0cc9e8c9..15a6c786b 100644 --- a/Src/CodeSnip.cfg.tplt +++ b/Src/CodeSnip.cfg.tplt @@ -30,12 +30,12 @@ -M -$M16384,1048576 -K$00400000 --E"..\Exe" --N0"..\Bin" --U"..\Bin;3rdParty" --O"..\Bin;3rdParty" --I"..\Bin;3rdParty" --R"..\Bin;3rdParty" +-E"..\_build\exe" +-N0"..\_build\bin" +-U"..\_build\bin;3rdParty" +-O"..\_build\bin;3rdParty" +-I"..\_build\bin;3rdParty" +-R"..\_build\bin;3rdParty" -w-SYMBOL_PLATFORM -w+EXPLICIT_STRING_CAST_LOSS -w+CVT_WIDENING_STRING_LOST diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 64bebc304..fa718dacc 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * CodeSnip application project file. } @@ -33,7 +33,6 @@ program CodeSnip; uses Forms, Windows, - GIFImage in '3rdParty\GIFImage.pas', LVEx in '3rdParty\LVEx.pas', PJMD5 in '3rdParty\PJMD5.pas', PJShellFolders in '3rdParty\PJShellFolders.pas', @@ -193,7 +192,7 @@ uses UBrowseProtocol in 'UBrowseProtocol.pas', UCategoryAction in 'UCategoryAction.pas', UCategoryListAdapter in 'UCategoryListAdapter.pas', - UClassHelpers in 'UClassHelpers.pas', + ClassHelpers.UControls in 'ClassHelpers.UControls.pas', UClipboardHelper in 'UClipboardHelper.pas', UCodeImportExport in 'UCodeImportExport.pas', UCodeImportMgr in 'UCodeImportMgr.pas', @@ -318,7 +317,6 @@ uses USingleton in 'USingleton.pas', USnipKindListAdapter in 'USnipKindListAdapter.pas', USnippetAction in 'USnippetAction.pas', - USnippetCreditsParser in 'USnippetCreditsParser.pas', USnippetDoc in 'USnippetDoc.pas', USnippetExtraHelper in 'USnippetExtraHelper.pas', USnippetHTML in 'USnippetHTML.pas', @@ -370,7 +368,19 @@ uses UWindowSettings in 'UWindowSettings.pas', UXMLDocConsts in 'UXMLDocConsts.pas', UXMLDocHelper in 'UXMLDocHelper.pas', - UXMLDocumentEx in 'UXMLDocumentEx.pas'; + UXMLDocumentEx in 'UXMLDocumentEx.pas', + FmDeleteUserDBDlg in 'FmDeleteUserDBDlg.pas' {DeleteUserDBDlg}, + Compilers.UAutoDetect in 'Compilers.UAutoDetect.pas', + Compilers.USettings in 'Compilers.USettings.pas', + FmRegisterCompilersDlg in 'FmRegisterCompilersDlg.pas' {RegisterCompilersDlg}, + ClassHelpers.UGraphics in 'ClassHelpers.UGraphics.pas', + ClassHelpers.UActions in 'ClassHelpers.UActions.pas', + USaveInfoMgr in 'USaveInfoMgr.pas', + ClassHelpers.RichEdit in 'ClassHelpers.RichEdit.pas', + UHTMLSnippetDoc in 'UHTMLSnippetDoc.pas', + UMarkdownUtils in 'UMarkdownUtils.pas', + ActiveText.UMarkdownRenderer in 'ActiveText.UMarkdownRenderer.pas', + UMarkdownSnippetDoc in 'UMarkdownSnippetDoc.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index b2b923cf6..5eaa734a3 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -16,9 +16,9 @@ <PropertyGroup Condition="'$(Base)'!=''"> <DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)</DCC_UnitAlias> <DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM> - <DCC_ExeOutput>..\Exe</DCC_ExeOutput> - <DCC_UnitSearchPath>..\Bin;3rdParty;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> - <DCC_DependencyCheckOutputName>..\Exe\CodeSnip.exe</DCC_DependencyCheckOutputName> + <DCC_ExeOutput>..\_build\exe</DCC_ExeOutput> + <DCC_UnitSearchPath>..\_build\bin;3rdParty;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> + <DCC_DependencyCheckOutputName>..\_build\exe\CodeSnip.exe</DCC_DependencyCheckOutputName> <DCC_CVT_WIDENING_STRING_LOST>true</DCC_CVT_WIDENING_STRING_LOST> <DCC_CVT_ACHAR_TO_WCHAR>true</DCC_CVT_ACHAR_TO_WCHAR> <DCC_Platform>x86</DCC_Platform> @@ -29,14 +29,13 @@ <DCC_S>false</DCC_S> <DCC_F>false</DCC_F> <DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo> - <DCC_DcuOutput>..\Bin</DCC_DcuOutput> + <DCC_DcuOutput>..\_build\bin</DCC_DcuOutput> <DCC_E>false</DCC_E> </PropertyGroup> <ItemGroup> <DelphiCompile Include="CodeSnip.dpr"> <MainSource>MainSource</MainSource> </DelphiCompile> - <DCCReference Include="3rdParty\GIFImage.pas"/> <DCCReference Include="3rdParty\LVEx.pas"/> <DCCReference Include="3rdParty\PJMD5.pas"/> <DCCReference Include="3rdParty\PJShellFolders.pas"/> @@ -395,7 +394,7 @@ <DCCReference Include="UBrowseProtocol.pas"/> <DCCReference Include="UCategoryAction.pas"/> <DCCReference Include="UCategoryListAdapter.pas"/> - <DCCReference Include="UClassHelpers.pas"/> + <DCCReference Include="ClassHelpers.UControls.pas"/> <DCCReference Include="UClipboardHelper.pas"/> <DCCReference Include="UCodeImportExport.pas"/> <DCCReference Include="UCodeImportMgr.pas"/> @@ -520,7 +519,6 @@ <DCCReference Include="USingleton.pas"/> <DCCReference Include="USnipKindListAdapter.pas"/> <DCCReference Include="USnippetAction.pas"/> - <DCCReference Include="USnippetCreditsParser.pas"/> <DCCReference Include="USnippetDoc.pas"/> <DCCReference Include="USnippetExtraHelper.pas"/> <DCCReference Include="USnippetHTML.pas"/> @@ -573,6 +571,22 @@ <DCCReference Include="UXMLDocConsts.pas"/> <DCCReference Include="UXMLDocHelper.pas"/> <DCCReference Include="UXMLDocumentEx.pas"/> + <DCCReference Include="FmDeleteUserDBDlg.pas"> + <Form>DeleteUserDBDlg</Form> + </DCCReference> + <DCCReference Include="Compilers.UAutoDetect.pas"/> + <DCCReference Include="Compilers.USettings.pas"/> + <DCCReference Include="FmRegisterCompilersDlg.pas"> + <Form>RegisterCompilersDlg</Form> + </DCCReference> + <DCCReference Include="ClassHelpers.UGraphics.pas"/> + <DCCReference Include="ClassHelpers.UActions.pas"/> + <DCCReference Include="USaveInfoMgr.pas"/> + <DCCReference Include="ClassHelpers.RichEdit.pas"/> + <DCCReference Include="UHTMLSnippetDoc.pas"/> + <DCCReference Include="UMarkdownUtils.pas"/> + <DCCReference Include="ActiveText.UMarkdownRenderer.pas"/> + <DCCReference Include="UMarkdownSnippetDoc.pas"/> <None Include="CodeSnip.todo"/> <BuildConfiguration Include="Base"> <Key>Base</Key> diff --git a/Src/CompilerChecks.inc b/Src/CompilerChecks.inc index 61b29f2de..31efffcca 100644 --- a/Src/CompilerChecks.inc +++ b/Src/CompilerChecks.inc @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Include file that checks details of compiler to determine whether or not * CodeSnip can be compiled. diff --git a/Src/Compilers.UAutoDetect.pas b/Src/Compilers.UAutoDetect.pas new file mode 100644 index 000000000..40d1bebea --- /dev/null +++ b/Src/Compilers.UAutoDetect.pas @@ -0,0 +1,115 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2022, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements a static class that can detect and register Delphi compilers + * present on the user's system that are not yet registered with CodeSnip. +} + + +unit Compilers.UAutoDetect; + +interface + +uses + Compilers.UGlobals, + Compilers.UCompilers, + UBaseObjects; + +type + TCompilerAutoDetect = class(TNoConstructObject) + public + type + TCallback = reference to procedure (Compiler: ICompiler); + strict private + class procedure DoCallback(const Callback: TCallback; + Compiler: ICompiler); + public + class procedure RegisterCompilers(Compilers: ICompilers; + const Callback: TCallback = nil); overload; + class procedure RegisterSpecificCompilers(AllCompilers: ICompilers; + const RegList: TCompilerList; const Callback: TCallback = nil); + class procedure ListRegisterableCompilers(Compilers: ICompilers; + const Registerable: TCompilerList); + end; + +implementation + +uses + SysUtils; + +{ TCompilerAutoDetect } + +class procedure TCompilerAutoDetect.DoCallback( + const Callback: TCallback; Compiler: ICompiler); +begin + if Assigned(Callback) then + Callback(Compiler); +end; + +class procedure TCompilerAutoDetect.ListRegisterableCompilers( + Compilers: ICompilers; const Registerable: TCompilerList); +var + Compiler: ICompiler; +begin + Registerable.Clear; + for Compiler in Compilers do + begin + if not Supports(Compiler, ICompilerAutoDetect) then + Continue; // compiler can't be auto-detected/registered + if not (Compiler as ICompilerAutoDetect).IsInstalled then + Continue; // compiler is not installed on the user's system + if Compiler.IsAvailable then + Continue; // compiler installed & already registered for use by CodeSnip + if not (Compiler as ICompilerAutoDetect).GetCanAutoInstall then + Continue; // user has excluded this compiler from being auto-registered + // We get here then we have an installed, un-registered, auto-detectable + // compiler with permission to register + Registerable.Add(Compiler); + end; +end; + +class procedure TCompilerAutoDetect.RegisterSpecificCompilers( + AllCompilers: ICompilers; const RegList: TCompilerList; + const Callback: TCallback); +var + Compiler: ICompiler; +begin + for Compiler in AllCompilers do + begin + if RegList.IndexOf(Compiler) >= 0 then + begin + Assert(Supports(Compiler, ICompilerAutoDetect), ClassName + + '.RegisterCompilers: Compiler does not support ICompilerAutoDetect'); + if (Compiler as ICompilerAutoDetect).DetectExeFile then + DoCallback(Callback, Compiler); + end; + end; +end; + +class procedure TCompilerAutoDetect.RegisterCompilers(Compilers: ICompilers; + const Callback: TCallback); +var + Registerable: TCompilerList; + Compiler: ICompiler; +begin + Registerable := TCompilerList.Create; + try + ListRegisterableCompilers(Compilers, Registerable); + for Compiler in Registerable do + begin + Assert(Supports(Compiler, ICompilerAutoDetect), ClassName + + '.RegisterCompilers: Compiler does not support ICompilerAutoDetect'); + if (Compiler as ICompilerAutoDetect).DetectExeFile then + DoCallback(Callback, Compiler); + end; + finally + Registerable.Free; + end; +end; + +end. + diff --git a/Src/Compilers.UBDS.pas b/Src/Compilers.UBDS.pas index e13e1424a..7c999be6a 100644 --- a/Src/Compilers.UBDS.pas +++ b/Src/Compilers.UBDS.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2024, Peter Johnson (gravatar.com/delphidabbler). * * Class that controls and provides information about Borland CodeGear and * Embarcadero "BDS" Win32 compilers. @@ -150,6 +150,12 @@ function TBDSCompiler.GetIDString: string; Result := 'D103R'; ciD104S: Result := 'D104S'; + ciD11A: + Result := 'D11A'; + ciD12A: + Result := 'D12Y'; + ciD13F: + Result := 'D13F'; else raise EBug.Create(ClassName + '.GetIDString: Invalid ID'); end; @@ -157,20 +163,25 @@ function TBDSCompiler.GetIDString: string; function TBDSCompiler.GetName: string; resourcestring - sCompilerName = 'Delphi %d'; // template for name of compiler - sDelphiXE = 'Delphi XE'; // name of Delphi XE compiler - sDelphiXE2 = 'Delphi XE2'; // name of Delphi XE2 compiler - sDelphiXE3 = 'Delphi XE3'; // name of Delphi XE3 compiler - sDelphiXE4 = 'Delphi XE4'; // name of Delphi XE4 compiler - sDelphiXE5 = 'Delphi XE5'; // name of Delphi XE5 compiler - sDelphiXE6 = 'Delphi XE6'; // name of Delphi XE6 compiler - sDelphiXE7 = 'Delphi XE7'; // name of Delphi XE7 compiler - sDelphiXE8 = 'Delphi XE8'; // name of Delphi XE8 compiler - sDelphi10S = 'Delphi 10 Seattle'; // name of Delphi 10 compiler - sDelphi101B = 'Delphi 10.1 Berlin'; // name of Delphi 10.1 compiler - sDelphi102T = 'Delphi 10.2 Tokyo'; // name of Delphi 10.2 compiler - sDelphi103R = 'Delphi 10.3 Rio'; // name of Delphi 10.3 compiler - sDelphi104S = 'Delphi 10.4 Sydney'; // name of Delphi 10.4 compiler + // template for name of compiler with simple integer version number + sCompilerName = 'Delphi %d'; + // names of compilers not suitable for use with template + sDelphiXE = 'Delphi XE'; + sDelphiXE2 = 'Delphi XE2'; + sDelphiXE3 = 'Delphi XE3'; + sDelphiXE4 = 'Delphi XE4'; + sDelphiXE5 = 'Delphi XE5'; + sDelphiXE6 = 'Delphi XE6'; + sDelphiXE7 = 'Delphi XE7'; + sDelphiXE8 = 'Delphi XE8'; + sDelphi10S = 'Delphi 10'; // Seattle + sDelphi101B = 'Delphi 10.1'; // Berlin + sDelphi102T = 'Delphi 10.2'; // Tokyo + sDelphi103R = 'Delphi 10.3'; // Rio + sDelphi104S = 'Delphi 10.4'; // Sydney + sDelphi11A = 'Delphi 11.x'; // Alexandria + sDelphi12A = 'Delphi 12.x'; // Athens + sDelphi13F = 'Delphi 13.x'; // Florence begin case GetID of ciDXE: @@ -199,6 +210,12 @@ function TBDSCompiler.GetName: string; Result := sDelphi103R; ciD104S: Result := sDelphi104S; + ciD11A: + Result := sDelphi11A; + ciD12A: + Result := sDelphi12A; + ciD13F: + Result := sDelphi13F; else Result := Format(sCompilerName, [ProductVersion]); end; @@ -232,6 +249,9 @@ function TBDSCompiler.InstallationRegKey: string; ciD102T : Result := '\Software\Embarcadero\BDS\19.0'; ciD103R : Result := '\Software\Embarcadero\BDS\20.0'; ciD104S : Result := '\Software\Embarcadero\BDS\21.0'; + ciD11A : Result := '\Software\Embarcadero\BDS\22.0'; + ciD12A : Result := '\Software\Embarcadero\BDS\23.0'; + ciD13F : Result := '\Software\Embarcadero\BDS\37.0'; else raise EBug.Create(ClassName + '.InstallationRegKey: Invalid ID'); end; end; diff --git a/Src/Compilers.UBorland.pas b/Src/Compilers.UBorland.pas index 1a451aa01..79d680290 100644 --- a/Src/Compilers.UBorland.pas +++ b/Src/Compilers.UBorland.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Abstract base class for classes that control and provide information about * Borland compilers. @@ -35,11 +35,22 @@ TBorlandCompiler = class(TCompilerBase) var fId: TCompilerID; {Identifies compiler} + // Flags whether user permits compiler to be auto installed. + fCanAutoInstall: Boolean; function InstallPathFromReg(const RootKey: HKEY): string; {Gets compiler install root path from given registry root key, if present. @param RootKey [in] Given registry root key. @return Required root path or '' if not compiler not installed. } + /// <summary>Gets the path to the compiler exe file if the compiler is + /// registered as installed on the user's computer.</summary> + /// <param name="ExePath">string [out] Set to path to compiler executable + /// file. Empty string if compiler not installed.</param> + /// <returns>Boolean. True if compiler is registered as installed or False + /// otherwise.</returns> + /// <remarks>Does not check if compiler exe is actually present, just if + /// it is registered.</remarks> + function GetExePathIfInstalled(out ExePath: string): Boolean; strict protected function SearchDirParams: string; override; {One of more parameters that define any search directories to be passed @@ -61,10 +72,35 @@ TBorlandCompiler = class(TCompilerBase) @param Obj Compiler object to copy. } { ICompilerAutoDetect } + /// <summary>Detects and records path to command line compiler exe file, + /// if compiler is registered as installed.</summary> + /// <returns>Boolean. True if compiler is registered as installed, False + /// otherwise.</returns> + /// <remarks> + /// <para>Does not check if the compiler exe file actually exists.</para> + /// <para>Does not set compiler exe file if compiler is not installed. + /// </para> + /// <para>Method of ICompilerAutoDetect.</para> + /// </remarks> function DetectExeFile: Boolean; - {Detects and records path to command line compiler if present. - @return True if compiler path found, false otherwise. - } + /// <summary>Checks if the compiler is installed on the user's system. + /// </summary> + /// <returns>Boolean. True if compiler is physically installed, False + /// otherwise.</returns> + /// <remarks> + /// <para>Checks if compiler exe is actually present.</para> + /// <para>Method of ICompilerAutoDetect.</para> + /// </remarks> + function IsInstalled: Boolean; + /// <summary>Checks if the compiler is permitted to be automatically + /// installed.</summary> + /// <remarks>Method of ICompilerAutoDetect.</remarks> + function GetCanAutoInstall: Boolean; + /// <summary>Determines whether the compiler can be automatically + /// installed.</summary> + /// <remarks>Method of ICompilerAutoDetect.</remarks> + procedure SetCanAutoInstall(const Value: Boolean); + { ICompiler } function GetDefaultSwitches: string; override; {Returns default command line switches for compiler. @@ -88,7 +124,7 @@ implementation uses // Delphi - SysUtils, Registry, + SysUtils, Registry, IOUtils, // Project UIStringList, UStrUtils, USystemInfo; @@ -109,6 +145,7 @@ constructor TBorlandCompiler.CreateCopy(const Obj: TBorlandCompiler); begin inherited CreateCopy(Obj); fId := Obj.GetID; + fCanAutoInstall := Obj.GetCanAutoInstall; end; procedure TBorlandCompiler.DeleteObjFiles(const Path, Project: string); @@ -128,17 +165,16 @@ function TBorlandCompiler.DetectExeFile: Boolean; @return True if compiler path found, false otherwise. } var - InstDir: string; // installation root directory + ExePath: string; begin - // try HKLM - InstDir := InstallPathFromReg(HKEY_LOCAL_MACHINE); - if InstDir = '' then - // in case install was for user only, try HKCU - InstDir := InstallPathFromReg(HKEY_CURRENT_USER); - if InstDir = '' then - Exit(False); - SetExecFile(IncludeTrailingPathDelimiter(InstDir) + 'Bin\DCC32.exe'); - Result := True; + Result := GetExePathIfInstalled(ExePath); + if Result then + SetExecFile(ExePath); +end; + +function TBorlandCompiler.GetCanAutoInstall: Boolean; +begin + Result := fCanAutoInstall; end; function TBorlandCompiler.GetDefaultSwitches: string; @@ -161,6 +197,22 @@ function TBorlandCompiler.GetDefaultSwitches: string; + '-$P+'; // Open string params ON end; +function TBorlandCompiler.GetExePathIfInstalled(out ExePath: string): Boolean; +var + InstDir: string; +begin + ExePath := ''; + // try HKLM + InstDir := InstallPathFromReg(HKEY_LOCAL_MACHINE); + if InstDir = '' then + // in case install was for user only, try HKCU + InstDir := InstallPathFromReg(HKEY_CURRENT_USER); + if InstDir = '' then + Exit(False); + ExePath := TPath.Combine(InstDir, 'Bin\DCC32.exe'); + Result := True; +end; + function TBorlandCompiler.GetID: TCompilerID; {Provides the unique id of the compiler. @return Compiler id. @@ -192,6 +244,15 @@ function TBorlandCompiler.InstallPathFromReg(const RootKey: HKEY): string; end; end; +function TBorlandCompiler.IsInstalled: Boolean; +var + ExePath: string; +begin + if not GetExePathIfInstalled(ExePath) then + Exit(False); + Result := TFile.Exists(ExePath, False); +end; + function TBorlandCompiler.SearchDirParams: string; {One of more parameters that define any search directories to be passed to compiler on command line. @@ -209,5 +270,10 @@ function TBorlandCompiler.SearchDirParams: string; + ' ' + StrQuoteSpaced('-R' + Dirs.GetText(';', False)); end; +procedure TBorlandCompiler.SetCanAutoInstall(const Value: Boolean); +begin + fCanAutoInstall := Value; +end; + end. diff --git a/Src/Compilers.UCompilerBase.pas b/Src/Compilers.UCompilerBase.pas index cb186a4f3..e7517c33a 100644 --- a/Src/Compilers.UCompilerBase.pas +++ b/Src/Compilers.UCompilerBase.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Abstract base class for classes that control and provide information about * compilers. Also provides a specialised exception class. diff --git a/Src/Compilers.UCompilers.pas b/Src/Compilers.UCompilers.pas index 01334da44..92b6e7881 100644 --- a/Src/Compilers.UCompilers.pas +++ b/Src/Compilers.UCompilers.pas @@ -2,9 +2,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Provides a class that maintains a list of all supported compilers and creates * a global singleton instance of the list. Also provides a class that can @@ -20,6 +20,8 @@ interface uses + // Delphi + Generics.Collections, // Project Compilers.UGlobals, UBaseObjects; @@ -64,13 +66,18 @@ TCompilersFactory = class(TNoConstructObject) } end; + TCompilerList = class(TList<ICompiler>) + public + constructor Create; + end; + implementation uses // Delphi - Generics.Collections, SysUtils, + Generics.Defaults, SysUtils, // Project Compilers.UBDS, Compilers.UDelphi, Compilers.UFreePascal, Compilers.USearchDirs, IntfCommon, UConsts, UExceptions, UIStringList, @@ -328,6 +335,12 @@ procedure TPersistCompilers.Load(const Compilers: ICompilers); // Load search directories SearchDirNames := Storage.GetStrings('SearchDirCount', 'SearchDir%d'); Compiler.SetSearchDirs(TSearchDirs.Create(SearchDirNames.ToArray)); + + // Check if compiler can be auto-detected + if Supports(Compiler, ICompilerAutoDetect) then + (Compiler as ICompilerAutoDetect).SetCanAutoInstall( + Storage.GetBoolean('CanAutoInstall', True) + ); end; end; @@ -363,10 +376,28 @@ procedure TPersistCompilers.Save(const Compilers: ICompilers); Storage.SetString('Namespaces', Compiler.GetRTLNamespaces); SearchDirNames := TIStringList.Create(Compiler.GetSearchDirs.ToStrings); Storage.SetStrings('SearchDirCount', 'SearchDir%d', SearchDirNames); + if Supports(Compiler, ICompilerAutoDetect) then + Storage.SetBoolean( + 'CanAutoInstall', (Compiler as ICompilerAutoDetect).GetCanAutoInstall + ); // save the data Storage.Save; end; end; +{ TCompilerList } + +constructor TCompilerList.Create; +begin + inherited Create( + TDelegatedComparer<ICompiler>.Create( + function (const Left, Right: ICompiler): Integer + begin + Result := Ord(Left.GetID) - Ord(Right.GetID); + end + ) + ) +end; + end. diff --git a/Src/Compilers.UDelphi.pas b/Src/Compilers.UDelphi.pas index 009631009..6ca68436e 100644 --- a/Src/Compilers.UDelphi.pas +++ b/Src/Compilers.UDelphi.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Class that controls and provides information about the Delphi v2-7 compilers. } diff --git a/Src/Compilers.UFreePascal.pas b/Src/Compilers.UFreePascal.pas index 32b66548b..82c4fbc38 100644 --- a/Src/Compilers.UFreePascal.pas +++ b/Src/Compilers.UFreePascal.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements class that wraps the Free Pascal compiler. Controls compilation, * processes compiler output and provides information about the compiler. diff --git a/Src/Compilers.UGlobals.pas b/Src/Compilers.UGlobals.pas index aff4f39d3..be018b805 100644 --- a/Src/Compilers.UGlobals.pas +++ b/Src/Compilers.UGlobals.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Declares various types that describe the compiler and compilation results and * defines interfaces to compiler objects. @@ -42,7 +42,10 @@ interface ciD101B, // Delphi 10.1 Berlin ciD102T, // Delphi 10.2 Tokyo ciD103R, // Delphi 10.3 Rio - ciD104S, // Delphi 10.4 Sydney + ciD104S, // Delphi 10.4 Sydney, + ciD11A, // Delphi 11.x Alexandria + ciD12A, // Delphi 12 Athens + ciD13F, // Delphi 13 Florence ciFPC // Free Pascal ); @@ -56,7 +59,7 @@ interface cBDSCompilers = [ ciD2005w32, ciD2006w32, ciD2007, ciD2009w32, ciD2010, ciDXE, ciDXE2, ciDXE3, ciDXE4, ciDXE5, ciDXE6, ciDXE7, ciDXE8, ciD10S, ciD101B, ciD102T, - ciD103R, ciD104S + ciD103R, ciD104S, ciD11A, ciD12A, ciD13F ]; const @@ -298,7 +301,7 @@ interface property Count: Integer read GetCount; /// <summary>Number of compilers installed on this computer and made - /// available CodeSnip.</summary> + /// available to CodeSnip.</summary> property AvailableCount: Integer read GetAvailableCount; /// <summary>Checks if any compilers in the list are displayable.</summary> @@ -326,6 +329,15 @@ interface /// <summary>Detects and records the full path of the compiler's /// executable.</summary> function DetectExeFile: Boolean; + /// <summary>Checks if the compiler is installed on the user's system. + /// </summary> + function IsInstalled: Boolean; + /// <summary>Checks if the compiler is permitted to be automatically + /// installed.</summary> + function GetCanAutoInstall: Boolean; + /// <summary>Determines whether the compiler can be automatically + /// installed.</summary> + procedure SetCanAutoInstall(const Value: Boolean); end; diff --git a/Src/Compilers.URunner.pas b/Src/Compilers.URunner.pas index 3be906d8a..96630ca1f 100644 --- a/Src/Compilers.URunner.pas +++ b/Src/Compilers.URunner.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a class that executes a compiler and captures its output and exit * code. Also provides specialised exception object that captures information diff --git a/Src/Compilers.USearchDirs.pas b/Src/Compilers.USearchDirs.pas index 4c195bfde..5c2199016 100644 --- a/Src/Compilers.USearchDirs.pas +++ b/Src/Compilers.USearchDirs.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a class that encapsulates a list of search directories for use * by the compiler. diff --git a/Src/Compilers.USettings.pas b/Src/Compilers.USettings.pas new file mode 100644 index 000000000..2a1fe77ae --- /dev/null +++ b/Src/Compilers.USettings.pas @@ -0,0 +1,83 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2022-2023, Peter Johnson (gravatar.com/delphidabbler). + * + * Class that reads and writes settings that apply to all compilers. +} + + +unit Compilers.USettings; + +interface + +uses + // Delphi + SysUtils, + // Project + UBaseObjects, + USettings; + +type + /// <summary>Manages settings that apply to all compilers.</summary> + TCompilerSettings = class(TNoConstructObject) + strict private + const + AllCompilersConfigSection = ssCompilers; + PermitStartupDetectionKey = 'PermitStartupDetection'; + class function ReadStorage: ISettingsSection; + class procedure DoSaveProperty(const WriteProp: TProc<ISettingsSection>); + class procedure SaveProperty(const Key: string; const Value: Boolean); + class function GetPermitStartupDetection: Boolean; static; + class procedure SetPermitStartupDetection(const Value: Boolean); static; + public + class property PermitStartupDetection: Boolean + read GetPermitStartupDetection write SetPermitStartupDetection + default True; + end; + +implementation + +{ TCompilerSettings } + +class procedure TCompilerSettings.DoSaveProperty( + const WriteProp: TProc<ISettingsSection>); +var + Stg: ISettingsSection; +begin + Stg := ReadStorage; + WriteProp(Stg); + Stg.Save; +end; + +class function TCompilerSettings.GetPermitStartupDetection: Boolean; +begin + Result := ReadStorage.GetBoolean(PermitStartupDetectionKey, True); +end; + +class function TCompilerSettings.ReadStorage: ISettingsSection; +begin + Result := Settings.ReadSection(AllCompilersConfigSection); +end; + +class procedure TCompilerSettings.SaveProperty(const Key: string; + const Value: Boolean); +begin + DoSaveProperty( + procedure(Stg: ISettingsSection) + begin + Stg.SetBoolean(Key, Value) + end + ); +end; + +class procedure TCompilerSettings.SetPermitStartupDetection( + const Value: Boolean); +begin + SaveProperty(PermitStartupDetectionKey, Value); +end; + +end. + diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index cf810503e..c5860d3c0 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2021, Peter Johnson (gravatar.com/delphidabbler). * * Objects, records etc that encapsulate a category, its data and lists of * categories. diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index f256c7ab7..4fe633fbb 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements objects that can load data into the Database object from both the * user and main databases. Also provides a class that can write the user diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 447a709c6..6b61183e1 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Defines a singleton object and subsidiary classes that encapsulate the * snippets and categories in the CodeSnip database and user defined databases. @@ -954,11 +954,9 @@ procedure TDatabase.Load; try // Load main database: MUST do this first since user database can // reference objects in main database - with TDatabaseIOFactory.CreateMainDBLoader do - Load(fSnippets, fCategories, Factory); + TDatabaseIOFactory.CreateMainDBLoader.Load(fSnippets, fCategories, Factory); // Load any user database - with TDatabaseIOFactory.CreateUserDBLoader do - Load(fSnippets, fCategories, Factory); + TDatabaseIOFactory.CreateUserDBLoader.Load(fSnippets, fCategories, Factory); fUpdated := False; except // If an exception occurs clear the database @@ -984,8 +982,7 @@ procedure TDatabase.Save; // Create object that can provide required information about user database Provider := TUserDataProvider.Create(fSnippets, fCategories); // Use a writer object to write out the database - with TDatabaseIOFactory.CreateWriter do - Write(fSnippets, fCategories, Provider); + TDatabaseIOFactory.CreateWriter.Write(fSnippets, fCategories, Provider); fUpdated := False; end; diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index d6c2c6870..1c26520f3 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2020-2021, Peter Johnson (gravatar.com/delphidabbler). * * Provides meta data for the current main database and for any database * updates. @@ -762,7 +762,7 @@ function TV1DBMetaFiles.LicenseInfo: TStringDynArray; 'LicenseURL=https://opensource.org/licenses/MIT', 'CopyrightDate=2005-2016', 'CopyrightHolder=Peter Johnson & Contributors', - 'CopyrightHolderURL=http://gravatar.com/delphidabbler' + 'CopyrightHolderURL=https://gravatar.com/delphidabbler' ); end; diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index d30c3e785..5af498162 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2022, Peter Johnson (gravatar.com/delphidabbler). * * Objects, records etc that encapsulate a code snippet, its data and lists of * code snippets. @@ -328,10 +328,17 @@ TSnippetList = class(TObject) {Counts number of snippets in list. @return Number of snippets in list. } - function IsEmpty: Boolean; inline; + function IsEmpty: Boolean; overload; inline; {Checks if list is empty. @return True if list is empty, False otehrwise. } + function IsEmpty(const UserDefined: Boolean): Boolean; overload; inline; + {Checks if sub-set of list from either from or not from use defined + database is empty. + @param UserDefined [in] Flags whether to check for snippets in user + database (True) or in main database (False). + @return True if required subset is empty, False if not empty. + } property Items[Idx: Integer]: TSnippet read GetItem; default; {List of snippets} end; @@ -764,6 +771,11 @@ function TSnippetList.IsEmpty: Boolean; Result := Count = 0; end; +function TSnippetList.IsEmpty(const UserDefined: Boolean): Boolean; +begin + Result := Count(UserDefined) = 0; +end; + function TSnippetList.IsEqual(const AList: TSnippetList): Boolean; {Checks if this list contains same snippets as another list. @param AList [in] List of snippets to compare. diff --git a/Src/DB.USnippetKind.pas b/Src/DB.USnippetKind.pas index f71d17b8b..45fbed42e 100644 --- a/Src/DB.USnippetKind.pas +++ b/Src/DB.USnippetKind.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines a record that provides information about the different snippet kinds * enumerated by TSnippetKind along with a static class that provides an diff --git a/Src/DBIO.UFileIOIntf.pas b/Src/DBIO.UFileIOIntf.pas index b515b61d7..f9c88923e 100644 --- a/Src/DBIO.UFileIOIntf.pas +++ b/Src/DBIO.UFileIOIntf.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines interfaces implemented by classes that read and write physical code * snippets database files. Also provides an exception class for data I/O diff --git a/Src/DBIO.UIniDataReader.pas b/Src/DBIO.UIniDataReader.pas index 271bedd2b..0e6d97f40 100644 --- a/Src/DBIO.UIniDataReader.pas +++ b/Src/DBIO.UIniDataReader.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements code that reads the main CodeSnip database from .ini and .dat * files. @@ -235,7 +235,9 @@ implementation 'Delphi2005Win32', 'Delphi2006Win32', 'Delphi2007', 'Delphi2009Win32', 'Delphi2010', 'DelphiXE', 'DelphiXE2', 'DelphiXE3', 'DelphiXE4', 'DelphiXE5', 'DelphiXE6', 'DelphiXE7', 'DelphiXE8', 'Delphi10S', - 'Delphi101B', 'Delphi102T', 'Delphi103R', 'Delphi104S', 'FPC' + 'Delphi101B', 'Delphi102T', 'Delphi103R', 'Delphi104S', 'Delphi11A', + 'Delphi12A', 'Delphi13F', + 'FPC' ); { TIniDataReader } diff --git a/Src/DBIO.UNulDataReader.pas b/Src/DBIO.UNulDataReader.pas index 1afe8d05c..ab6e8ecf2 100644 --- a/Src/DBIO.UNulDataReader.pas +++ b/Src/DBIO.UNulDataReader.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a do nothing data reader for use when a database does not exist. } diff --git a/Src/DBIO.UXMLDataIO.pas b/Src/DBIO.UXMLDataIO.pas index e23797411..0d1c0c0fc 100644 --- a/Src/DBIO.UXMLDataIO.pas +++ b/Src/DBIO.UXMLDataIO.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements classes that can read and write databases stored in XML format * with associated source code files. @@ -950,7 +950,7 @@ procedure TXMLDataWriter.WriteSnippetProps(const SnippetName: string; ); fXMLDoc.CreateElement(SnippetNode, cDisplayNameNode, Props.DisplayName); // extra node is only written if extra property has a value - if not Props.Extra.IsEmpty then + if Props.Extra.HasContent then begin fXMLDoc.CreateElement( SnippetNode, diff --git a/Src/ExternalObj.ridl b/Src/ExternalObj.ridl index 906a6400c..fcf28f613 100644 --- a/Src/ExternalObj.ridl +++ b/Src/ExternalObj.ridl @@ -1,9 +1,9 @@ /* * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Source for type library that defines the interface to extensions to the * browser control DOM's "external object". diff --git a/Src/Favourites.UFavourites.pas b/Src/Favourites.UFavourites.pas index a95decfbc..0a5154621 100644 --- a/Src/Favourites.UFavourites.pas +++ b/Src/Favourites.UFavourites.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines types used to encapsulate a list of a user's favourite snippets. } diff --git a/Src/Favourites.UManager.pas b/Src/Favourites.UManager.pas index 25a3975a0..da119c289 100644 --- a/Src/Favourites.UManager.pas +++ b/Src/Favourites.UManager.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines a class used to manage interaction with, and updating of, the user's * favourites. diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 32409eed5..9f73ab49d 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines an advanced record that can persist a list of favourites to and from * a file on a per user basis. diff --git a/Src/FirstRun.FmV4ConfigDlg.pas b/Src/FirstRun.FmV4ConfigDlg.pas index 4baa0bab2..122d67563 100644 --- a/Src/FirstRun.FmV4ConfigDlg.pas +++ b/Src/FirstRun.FmV4ConfigDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a wizard dialogue box that may be displayed on the first run of * CodeSnip v4 to get user to decide whether what data to bring forward from @@ -289,14 +289,16 @@ function TV4ConfigDlg.DatabaseAvailable: Boolean; class procedure TV4ConfigDlg.Execute(AOwner: TComponent; const FirstRun: TFirstRun); +var + Dlg: TV4ConfigDlg; begin - with InternalCreate(AOwner) do - try - fFirstRun := FirstRun; - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fFirstRun := FirstRun; + Dlg.ShowModal; + finally + Dlg.Free; + end; end; procedure TV4ConfigDlg.FormCloseQuery(Sender: TObject; var CanClose: Boolean); diff --git a/Src/FirstRun.FmWhatsNew.FrHTML.pas b/Src/FirstRun.FmWhatsNew.FrHTML.pas index ce0274836..749ea3122 100644 --- a/Src/FirstRun.FmWhatsNew.FrHTML.pas +++ b/Src/FirstRun.FmWhatsNew.FrHTML.pas @@ -1,3 +1,14 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2020-2022, Peter Johnson (gravatar.com/delphidabbler). + * + * Frame that displays HTML of "what's new" message in a TWebBrowser control. +} + + unit FirstRun.FmWhatsNew.FrHTML; interface @@ -56,34 +67,24 @@ procedure TWhatsNewHTMLFrame.BuildCSS(const CSSBuilder: TCSSBuilder); try TFontHelper.SetContentFont(CSSFont); CSSFont.Size := CSSFont.Size + 2; - with CSSBuilder.AddSelector('body') do - begin - AddProperty(TCSS.FontProps(CSSFont)); - AddProperty(TCSS.MarginProp(0, 8, 0, 8)); - end; - with CSSBuilder.AddSelector('.lead') do - begin - AddProperty(TCSS.FontSizeProp(CSSFont.Size + 2)); - AddProperty(TCSS.FontWeightProp(cfwBold)); - AddProperty(TCSS.ColorProp($233bc2)); - end; + CSSBuilder.AddSelector('body') + .AddProperty(TCSS.FontProps(CSSFont)) + .AddProperty(TCSS.MarginProp(0, 8, 0, 8)); + CSSBuilder.AddSelector('.lead') + .AddProperty(TCSS.FontSizeProp(CSSFont.Size + 2)) + .AddProperty(TCSS.FontWeightProp(cfwBold)) + .AddProperty(TCSS.ColorProp($233bc2)); // Sets paragraph margins and padding - with CSSBuilder.AddSelector('p') do - begin - AddProperty(TCSS.MarginProp(cssTop, 6)); - AddProperty(TCSS.MarginProp(cssBottom, 0)); - AddProperty(TCSS.PaddingProp(0)); - end; - with CSSBuilder.AddSelector('ul') do - begin - AddProperty(TCSS.MarginProp(cssTop, 6)); - AddProperty(TCSS.MarginProp(cssBottom, 0)); - AddProperty(TCSS.PaddingProp(0)); - end; - with CSSBuilder.AddSelector('li') do - begin - AddProperty(TCSS.MarginProp(cssTop, 6)); - end; + CSSBuilder.AddSelector('p') + .AddProperty(TCSS.MarginProp(cssTop, 6)) + .AddProperty(TCSS.MarginProp(cssBottom, 0)) + .AddProperty(TCSS.PaddingProp(0)); + CSSBuilder.AddSelector('ul') + .AddProperty(TCSS.MarginProp(cssTop, 6)) + .AddProperty(TCSS.MarginProp(cssBottom, 0)) + .AddProperty(TCSS.PaddingProp(0)); + CSSBuilder.AddSelector('li') + .AddProperty(TCSS.MarginProp(cssTop, 6)); finally CSSFont.Free; end; diff --git a/Src/FirstRun.FmWhatsNew.pas b/Src/FirstRun.FmWhatsNew.pas index 495ca9fee..4cc6e9778 100644 --- a/Src/FirstRun.FmWhatsNew.pas +++ b/Src/FirstRun.FmWhatsNew.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2020-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements dialogue box that may be displayed the first time CodeSnip 4.x.x * is run after an update. The dialogue box displays a HTML page that draws @@ -114,13 +114,15 @@ procedure TWhatsNewDlg.CreateParams(var Params: TCreateParams); end; class procedure TWhatsNewDlg.Execute(AOwner: TComponent); +var + Dlg: TWhatsNewDlg; begin - with InternalCreate(AOwner) do - try - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.ShowModal; + finally + Dlg.Free; + end; end; function TWhatsNewDlg.GetAligner: IFormAligner; diff --git a/Src/FirstRun.UConfigFile.pas b/Src/FirstRun.UConfigFile.pas index f2cfaa832..314eaaf62 100644 --- a/Src/FirstRun.UConfigFile.pas +++ b/Src/FirstRun.UConfigFile.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2022, Peter Johnson (gravatar.com/delphidabbler). * * Implements class that manages the updating of older config files to the * current format. @@ -82,7 +82,7 @@ TUserConfigFileUpdater = class(TConfigFileUpdater) strict private const /// <summary>Current user config file version.</summary> - FileVersion = 16; + FileVersion = 20; strict protected /// <summary>Returns current user config file version.</summary> class function GetFileVersion: Integer; override; diff --git a/Src/FirstRun.UDatabase.pas b/Src/FirstRun.UDatabase.pas index 7ad9c88f4..994c86989 100644 --- a/Src/FirstRun.UDatabase.pas +++ b/Src/FirstRun.UDatabase.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a class that handles updating of user database from an earlier * version. diff --git a/Src/FirstRun.UIniFile.pas b/Src/FirstRun.UIniFile.pas index 774824366..120ba48b0 100644 --- a/Src/FirstRun.UIniFile.pas +++ b/Src/FirstRun.UIniFile.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2021, Peter Johnson (gravatar.com/delphidabbler). * * Ini file access helper routines for use with first-run startup code. } diff --git a/Src/FirstRun.UInstallInfo.pas b/Src/FirstRun.UInstallInfo.pas index 22fc691b0..45514043c 100644 --- a/Src/FirstRun.UInstallInfo.pas +++ b/Src/FirstRun.UInstallInfo.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a class that provides information about CodeSnip installations. } diff --git a/Src/FirstRun.UMain.pas b/Src/FirstRun.UMain.pas index ba154a241..e5b610edc 100644 --- a/Src/FirstRun.UMain.pas +++ b/Src/FirstRun.UMain.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements classes that handle application start up, determine if it the * first run of the current version and perform necessary updates to per-user diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 01ee90ea6..a26397685 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * Implements the program's About dialogue box. } @@ -312,27 +312,29 @@ function TAboutDlg.ContribListHTML(ContribList: IStringList): begin for Contributor in ContribList do Result := Result - + THTML.CompoundTag('div', THTML.Entities(Contributor)) + + TXHTML.CompoundTag('div', TXHTML.Entities(Contributor)) + EOL; end else begin // List couldn't be found: display warning message DivAttrs := THTMLAttributes.Create('class', 'warning'); - Result := THTML.CompoundTag( - 'div', DivAttrs, THTML.Entities(sNoContributors) + Result := TXHTML.CompoundTag( + 'div', DivAttrs, TXHTML.Entities(sNoContributors) ); end; end; class procedure TAboutDlg.Execute(AOwner: TComponent); +var + Dlg: TAboutDlg; begin - with Create(AOwner) do - try - ShowModal; - finally - Free; - end; + Dlg := Create(AOwner); + try + Dlg.ShowModal; + finally + Dlg.Free; + end; end; procedure TAboutDlg.FormCreate(Sender: TObject); @@ -482,15 +484,15 @@ procedure TAboutDlg.InitHTMLFrames; 'DBLicense', StrIf( fMetaData.GetLicenseInfo.URL <> '', - THTML.CompoundTag( + TXHTML.CompoundTag( 'a', THTMLAttributes.Create([ THTMLAttribute.Create('href', fMetaData.GetLicenseInfo.URL), THTMLAttribute.Create('class', 'external-link') ]), - THTML.Entities(fMetaData.GetLicenseInfo.Name) + TXHTML.Entities(fMetaData.GetLicenseInfo.Name) ), - THTML.Entities(fMetaData.GetLicenseInfo.Name) + TXHTML.Entities(fMetaData.GetLicenseInfo.Name) ) ); Tplt.ResolvePlaceholderHTML( @@ -524,40 +526,36 @@ procedure TAboutDlg.UpdateDetailCSS(Sender: TObject; ContentFont: TFont; // font used for content begin // Modify body's margin and, for themed windows, background colour - with CSSBuilder.Selectors['body'] do - begin - ContentFont := TFont.Create; - try - TFontHelper.SetContentFont(ContentFont); - AddProperty(TCSS.FontProps(ContentFont)); - if ThemeServicesEx.ThemesEnabled then - AddProperty(TCSS.BackgroundColorProp(ThemeServicesEx.GetTabBodyColour)); - AddProperty(UCSSUtils.TCSS.MarginProp(0, 2, 6, 2)); - finally - FreeAndNil(ContentFont); - end; + ContentFont := TFont.Create; + try + TFontHelper.SetContentFont(ContentFont); + CSSBuilder.Selectors['body'] + .AddProperty(TCSS.FontProps(ContentFont)) + .AddProperty(UCSSUtils.TCSS.MarginProp(0, 2, 6, 2)) + .AddPropertyIf( + ThemeServicesEx.ThemesEnabled, + TCSS.BackgroundColorProp(ThemeServicesEx.GetTabBodyColour) + ); + finally + FreeAndNil(ContentFont); end; // Put border round scroll box - with CSSBuilder.AddSelector('.scrollbox') do - AddProperty(UCSSUtils.TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); + CSSBuilder.AddSelector('.scrollbox') + .AddProperty(UCSSUtils.TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); // Set colours and font style of contributors and testers headings - with CSSBuilder.AddSelector('.contrib-head, .tester-head') do - begin - AddProperty(TCSS.BackgroundColorProp(clBtnFace)); - AddProperty(TCSS.ColorProp(clBtnText)); - AddProperty(TCSS.FontWeightProp(cfwBold)); - end; + CSSBuilder.AddSelector('.contrib-head, .tester-head') + .AddProperty(TCSS.BackgroundColorProp(clBtnFace)) + .AddProperty(TCSS.ColorProp(clBtnText)) + .AddProperty(TCSS.FontWeightProp(cfwBold)); end; procedure TAboutDlg.UpdateTitleCSS(Sender: TObject; const CSSBuilder: TCSSBuilder); begin // Set body colour, and put border round it - with CSSBuilder.Selectors['body'] do - begin - AddProperty(TCSS.BackgroundColorProp(clWindow)); - AddProperty(TCSS.PaddingProp(4)); - end; + CSSBuilder.Selectors['body'] + .AddProperty(TCSS.BackgroundColorProp(clWindow)) + .AddProperty(TCSS.PaddingProp(4)); end; procedure TAboutDlg.ViewConfigFile(const FileName, DlgTitle: string); diff --git a/Src/FmActiveTextPreviewDlg.pas b/Src/FmActiveTextPreviewDlg.pas index b0774f678..747b40f20 100644 --- a/Src/FmActiveTextPreviewDlg.pas +++ b/Src/FmActiveTextPreviewDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that displays active text rendered from REML markup * or plain text. @@ -143,14 +143,16 @@ class procedure TActiveTextPreviewDlg.Execute(const AOwner: TComponent; @param AOwner [in] Component that owns this dialog box. @param ActiveText [in] Active text to be displayed as HTML. } +var + Dlg: TActiveTextPreviewDlg; begin - with InternalCreate(AOwner) do - try - fActiveText := ActiveText; - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fActiveText := ActiveText; + Dlg.ShowModal; + finally + Dlg.Free; + end; end; procedure TActiveTextPreviewDlg.HTMLEventHandler(Sender: TObject; @@ -162,6 +164,7 @@ procedure TActiveTextPreviewDlg.HTMLEventHandler(Sender: TObject; } var ALink: IDispatch; // reference to the any link that was clicked + ProtocolHander: TProtocol; resourcestring // Button captions for choice dialog box sClose = 'Close'; @@ -195,12 +198,12 @@ procedure TActiveTextPreviewDlg.HTMLEventHandler(Sender: TObject; ) = cViewLinkRes then begin // User wants to view link: use protocol handler to display it - with TProtocolFactory.CreateHandler(TAnchors.GetURL(ALink)) do - try - Execute; - finally - Free; - end; + ProtocolHander := TProtocolFactory.CreateHandler(TAnchors.GetURL(ALink)); + try + ProtocolHander.Execute; + finally + ProtocolHander.Free; + end; end; end; end; @@ -214,43 +217,62 @@ procedure TActiveTextPreviewDlg.UpdateCSS(Sender: TObject; const MaxHTMLHeight = 240; // max height of rendered HTML var - ContentFont: TFont; // font used for #content tab + ContentFont: TFont; // font used for #content tab begin ContentFont := TFont.Create; try TFontHelper.SetContentFont(ContentFont); // Set rendered REML container - with CSSBuilder.AddSelector('#content') do - begin - AddProperty(TCSS.FontProps(ContentFont)); - AddProperty(TCSS.BackgroundColorProp(clWindow)); - AddProperty(TCSS.PaddingProp(0, 6, 6, 6)); - AddProperty(TCSS.MarginProp(cssTop, 6)); - AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); - AddProperty(TCSS.OverflowProp(covAuto)); - AddProperty(TCSS.WidthProp(cluAuto, 0)); - // Use height instead of maxheight if IE 6 or lower - if TIEInfo.SupportsCSSMaxHeight then - AddProperty(TCSS.MaxHeightProp(MaxHTMLHeight)) - else - AddProperty(TCSS.HeightProp(MaxHTMLHeight)); - end; - with CSSBuilder.AddSelector('.active-text h2') do - begin - AddProperty(TCSS.MarginProp(4, 0, 0, 0)); - AddProperty(TCSS.FontWeightProp(cfwBold)); - AddProperty(TCSS.FontSizeProp(ContentFont.Size + 1)); - end; - with CSSBuilder.AddSelector('.active-text p') do - AddProperty(TCSS.MarginProp(4, 0, 0, 0)); + CSSBuilder.EnsureSelector('#content') + .AddProperty(TCSS.FontProps(ContentFont)) + .AddProperty(TCSS.BackgroundColorProp(clWindow)) + .AddProperty(TCSS.PaddingProp(0, 6, 6, 6)) + .AddProperty(TCSS.MarginProp(cssTop, 6)) + .AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)) + .AddProperty(TCSS.OverflowProp(covAuto)) + .AddProperty(TCSS.WidthProp(cluAuto, 0)) + .AddPropertyIf( + TIEInfo.SupportsCSSMaxHeight, + TCSS.MaxHeightProp(MaxHTMLHeight), + TCSS.HeightProp(MaxHTMLHeight) + ); + CSSBuilder.EnsureSelector('.active-text h2') + .AddProperty(TCSS.MarginProp(4, 0, 0, 0)) + .AddProperty(TCSS.FontWeightProp(cfwBold)) + .AddProperty(TCSS.FontSizeProp(ContentFont.Size + 1)); + CSSBuilder.EnsureSelector('.active-text p') + .AddProperty(TCSS.MarginProp(4, 0, 0, 0)); // Show or hide text about links depending on if links are present - with CSSBuilder.AddSelector('#linktext') do - begin - if ContainsLinks then - AddProperty(TCSS.DisplayProp(cdsInline)) - else - AddProperty(TCSS.DisplayProp(cdsNone)); - end; + CSSBuilder.EnsureSelector('#linktext') + .AddPropertyIf( + ContainsLinks, TCSS.DisplayProp(cdsInline), TCSS.DisplayProp(cdsNone) + ); + // Set up lists + CSSBuilder.EnsureSelector('.active-text ul') + .AddProperty(TCSS.MarginProp(cssAll, 0)) + .AddProperty(TCSS.MarginProp(cssTop, 4)) + .AddProperty(TCSS.PaddingProp(cssAll, 0)) + .AddProperty(TCSS.PaddingProp(cssLeft, 24)) + .AddProperty(TCSS.ListStylePositionProp(clspOutside)) + .AddProperty(TCSS.ListStyleTypeProp(clstDisc)); + CSSBuilder.EnsureSelector('.active-text ol') + .AddProperty(TCSS.MarginProp(cssAll, 0)) + .AddProperty(TCSS.MarginProp(cssTop, 4)) + .AddProperty(TCSS.PaddingProp(cssAll, 0)) + .AddProperty(TCSS.PaddingProp(cssLeft, 32)) + .AddProperty(TCSS.ListStylePositionProp(clspOutside)) + .AddProperty(TCSS.ListStyleTypeProp(clstDecimal)); + CSSBuilder.EnsureSelector('.active-text li') + .AddProperty(TCSS.PaddingProp(cssAll, 0)) + .AddProperty(TCSS.MarginProp(cssAll, 0)); + CSSBuilder.EnsureSelector('.active-text li ol') + .AddProperty(TCSS.MarginProp(cssTop, 0)); + CSSBuilder.EnsureSelector('.active-text li ul') + .AddProperty(TCSS.MarginProp(cssTop, 0)); + CSSBuilder.EnsureSelector('.active-text ul li') + .AddProperty(TCSS.PaddingProp(cssLeft, 8)); + CSSBuilder.EnsureSelector('.active-text ul li ol li') + .AddProperty(TCSS.PaddingProp(cssLeft, 0)); finally ContentFont.Free; end; diff --git a/Src/FmAddCategoryDlg.pas b/Src/FmAddCategoryDlg.pas index 403b39cbd..27ebb3258 100644 --- a/Src/FmAddCategoryDlg.pas +++ b/Src/FmAddCategoryDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that permits user to add a new user defined * category to the database. @@ -133,13 +133,15 @@ class function TAddCategoryDlg.Execute(AOwner: TComponent): Boolean; @param AOwner [in] Component that owns dialog box. @param CatList [in] List of categories available for deletion. } +var + Dlg: TAddCategoryDlg; begin - with InternalCreate(AOwner) do - try - Result := ShowModal = mrOK; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Result := Dlg.ShowModal = mrOK; + finally + Dlg.Free; + end; end; procedure TAddCategoryDlg.UpdateOKBtn; diff --git a/Src/FmBase.pas b/Src/FmBase.pas index e13503293..a20163b2c 100644 --- a/Src/FmBase.pas +++ b/Src/FmBase.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2024, Peter Johnson (gravatar.com/delphidabbler). * * Implements a form that provides the ancestor of all forms in the application. * Provides default names for form window classes along with various operations @@ -136,7 +136,8 @@ implementation // Delphi SysUtils, Windows, Menus, // Project - UAppInfo, UBaseObjects, UClassHelpers, UFontHelper, UKeysHelper, UMenus, + ClassHelpers.UControls, + UAppInfo, UBaseObjects, UFontHelper, UKeysHelper, UMenus, UNulFormAligner, UStrUtils; {$R *.dfm} diff --git a/Src/FmBugReportBaseDlg.pas b/Src/FmBugReportBaseDlg.pas index 6cbc80721..9d2a1161b 100644 --- a/Src/FmBugReportBaseDlg.pas +++ b/Src/FmBugReportBaseDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Provides a base class and common functionality for bug report dialogue boxes. } @@ -95,16 +95,18 @@ procedure TBugReportBaseDlg.GoToTracker; {Displays online bug tracker. Descendants should override to add extra functionality. } +var + BrowseAction: TBrowseURL; begin // NOTE: Don't change actBugTracker to TBrowseURL and delete this. Subclasses // must be able to override this method. - with TBrowseURL.Create(nil) do - try - URL := TURL.CodeSnipBugTracker; - Execute; - finally - Free; - end; + BrowseAction := TBrowseURL.Create(nil); + try + BrowseAction.URL := TURL.CodeSnipBugTracker; + BrowseAction.Execute; + finally + BrowseAction.Free; + end; end; procedure TBugReportBaseDlg.lblBugTrackerClick(Sender: TObject); diff --git a/Src/FmCategoryEditDlg.pas b/Src/FmCategoryEditDlg.pas index 4a006df55..d7356df46 100644 --- a/Src/FmCategoryEditDlg.pas +++ b/Src/FmCategoryEditDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements an abstract base class for dialogue boxes used to edit user * defined categories. diff --git a/Src/FmCodeExportDlg.pas b/Src/FmCodeExportDlg.pas index e220943ca..39cfdae8e 100644 --- a/Src/FmCodeExportDlg.pas +++ b/Src/FmCodeExportDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that gets snippets to be exported and creates an * export file containing the selected snippets. @@ -189,14 +189,16 @@ class procedure TCodeExportDlg.Execute(const AOwner: TComponent; @param Snippet [in] Reference to a snippet to pre-select in snippets check list box. If nil or not user-defined then no snippet is pre-selected. } +var + Dlg: TCodeExportDlg; begin - with InternalCreate(AOwner) do - try - SelectSnippet(Snippet); - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.SelectSnippet(Snippet); + Dlg.ShowModal; + finally + Dlg.Free; + end; end; procedure TCodeExportDlg.SelectSnippet(const Snippet: TSnippet); diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 475c8c06f..86f0fbef2 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -1,9 +1,9 @@ -{ +{ * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2025, Peter Johnson (gravatar.com/delphidabbler). * * Implements a wizard dialogue box that handles the import of user defined * snippets into the database. Permits snippets from the import file to be @@ -296,13 +296,15 @@ function TCodeImportDlg.CountImportSnippets: Integer; class function TCodeImportDlg.Execute(AOwner: TComponent; const ImportMgr: TCodeImportMgr): Boolean; +var + Dlg: TCodeImportDlg; begin - with InternalCreate(AOwner, ImportMgr) do - try - Result := ShowModal = mrOK; - finally - Free; - end; + Dlg := InternalCreate(AOwner, ImportMgr); + try + Result := Dlg.ShowModal = mrOK; + finally + Dlg.Free; + end; end; function TCodeImportDlg.GetFileNameFromEditCtrl: string; @@ -417,6 +419,8 @@ procedure TCodeImportDlg.PresentResults; /// Creates a label containing name of an imported snippet and adds it to /// scroll box with top at given position. procedure AddLabel(var Top: Integer; const SnippetName: string); + const + Bullet = #$2022; var Lbl: TLabel; begin @@ -424,7 +428,7 @@ procedure TCodeImportDlg.PresentResults; Lbl.Parent := sbFinish; Lbl.Left := 0; Lbl.Top := Top; - Lbl.Caption := '» ' + SnippetName; + Lbl.Caption := Bullet + ' ' + SnippetName; Top := TCtrlArranger.BottomOf(Lbl, 2); end; // --------------------------------------------------------------------------- diff --git a/Src/FmCompErrorDlg.pas b/Src/FmCompErrorDlg.pas index 7394c80b1..56744cc6a 100644 --- a/Src/FmCompErrorDlg.pas +++ b/Src/FmCompErrorDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that displays compiler error and warning logs. } @@ -180,18 +180,19 @@ class procedure TCompErrorDlg.Execute(const AOwner: TComponent; const ASnippet: TSnippet; const ACompilers: ICompilers); var Compiler: ICompiler; // each supported compiler + Dlg: TCompErrorDlg; begin Assert(Assigned(ACompilers), ClassName + '.Execute: ACompilers is nil'); - with InternalCreate(AOwner) do - try - fSnippet := ASnippet; - for Compiler in ACompilers do - if Compiler.HasErrorsOrWarnings then - fRequiredCompilers.Add(Compiler); - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fSnippet := ASnippet; + for Compiler in ACompilers do + if Compiler.HasErrorsOrWarnings then + Dlg.fRequiredCompilers.Add(Compiler); + Dlg.ShowModal; + finally + Dlg.Free; + end; end; procedure TCompErrorDlg.FormCreate(Sender: TObject); @@ -340,7 +341,7 @@ function TCompErrorDlg.TCompilerLog.LogListHTML: string; begin Result := ''; for Line in fLog do - Result := Result + THTML.CompoundTag('li', THTML.Entities(Line)) + EOL; + Result := Result + TXHTML.CompoundTag('li', TXHTML.Entities(Line)) + EOL; end; end. diff --git a/Src/FmCompilersDlg.FrBase.pas b/Src/FmCompilersDlg.FrBase.pas index 4f2c1fc96..b8d3a03f5 100644 --- a/Src/FmCompilersDlg.FrBase.pas +++ b/Src/FmCompilersDlg.FrBase.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a base class for all frames used for editing compiler information * in TCompilersDlg. diff --git a/Src/FmCompilersDlg.FrCompiler.dfm b/Src/FmCompilersDlg.FrCompiler.dfm index 1d844035a..91c15db22 100644 --- a/Src/FmCompilersDlg.FrCompiler.dfm +++ b/Src/FmCompilersDlg.FrCompiler.dfm @@ -1,4 +1,7 @@ inherited CompilersDlgCompilerFrame: TCompilersDlgCompilerFrame + DesignSize = ( + 362 + 235) object lblCompilerPath: TLabel Left = 4 Top = 4 @@ -46,9 +49,17 @@ inherited CompilersDlgCompilerFrame: TCompilersDlgCompilerFrame object chkShowInMain: TCheckBox Left = 4 Top = 88 - Width = 273 + Width = 320 Height = 17 Caption = 'Display &results for this compiler in details pane' TabOrder = 3 end + object chkPermitAutoDetect: TCheckBox + Left = 4 + Top = 111 + Width = 320 + Height = 17 + Caption = 'Permit &auto-detection && registration of this compiler' + TabOrder = 4 + end end diff --git a/Src/FmCompilersDlg.FrCompiler.pas b/Src/FmCompilersDlg.FrCompiler.pas index 3573903e8..b4657ab02 100644 --- a/Src/FmCompilersDlg.FrCompiler.pas +++ b/Src/FmCompilersDlg.FrCompiler.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2022, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame used to edit executable file name of compiler being edited * in TCompilersDlg. @@ -34,6 +34,7 @@ TCompilersDlgCompilerFrame = class(TCompilersDlgBaseFrame) btnBrowse: TButton; btnClear: TButton; chkShowInMain: TCheckBox; + chkPermitAutoDetect: TCheckBox; /// <summary>Displays file open dialog box and places entered file name in /// compiler file name edit control.</summary> procedure btnBrowseClick(Sender: TObject); @@ -98,6 +99,7 @@ procedure TCompilersDlgCompilerFrame.ArrangeControls; ); btnClear.Top := TCtrlArranger.BottomOf([edCompilerPath, btnBrowse], 8); chkShowInMain.Top := TCtrlArranger.BottomOf(btnClear, 24); + chkPermitAutoDetect.Top := TCtrlArranger.BottomOf(chkShowInMain, 8); end; procedure TCompilersDlgCompilerFrame.btnBrowseClick(Sender: TObject); @@ -164,12 +166,22 @@ procedure TCompilersDlgCompilerFrame.Initialise; begin edCompilerPath.Text := Compiler.GetExecFile; chkShowInMain.Checked := Compiler.GetDisplayable; + chkPermitAutoDetect.Visible := Supports(Compiler, ICompilerAutoDetect); + if chkPermitAutoDetect.Visible then + chkPermitAutoDetect.Checked := + (Compiler as ICompilerAutoDetect).GetCanAutoInstall + else + chkPermitAutoDetect.Checked := False; end; procedure TCompilersDlgCompilerFrame.UpdateCompiler; begin Compiler.SetExecFile(GetCompilerPath); Compiler.SetDisplayable(chkShowInMain.Checked); + if Supports(Compiler, ICompilerAutoDetect) then + (Compiler as ICompilerAutoDetect).SetCanAutoInstall( + chkPermitAutoDetect.Checked + ); end; function TCompilersDlgCompilerFrame.ValidateFileName(const FileName: string; diff --git a/Src/FmCompilersDlg.FrLog.pas b/Src/FmCompilersDlg.FrLog.pas index 16a6df827..581cd2bb7 100644 --- a/Src/FmCompilersDlg.FrLog.pas +++ b/Src/FmCompilersDlg.FrLog.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame used to change log file prefixes used for a compiler being * edited in TCompilersDlg. @@ -126,46 +126,43 @@ procedure TCompilersDlgLogFrame.vleLogPrefixesDrawCell(Sender: TObject; ACol, // Get reference to value editor ValEd := Sender as TValueListEditor; ValEd.Canvas.Font := ValEd.Font; - with ValEd.Canvas do + if gdFixed in State then begin - if gdFixed in State then - begin - // Set colours for fixed cells (non-editable) - Brush.Color := clBtnFace; - Font.Color := ValEd.Font.Color; - end - else - begin - // Set colours for editable cell - Brush.Color := ValEd.Color; - Font.Color := ValEd.Font.Color; - end; - // Colour the current cell - FillRect(Rect); - if gdFixed in State then - begin - // draw vertical line at right edge of fixed cell to act as border - Pen.Color := clBtnShadow; - MoveTo(Rect.Right - 1, Rect.Top); - LineTo(Rect.Right - 1, Rect.Bottom); - end; - // Display required text - TextOut( - Rect.Left + 2 , - Rect.Top + (ValEd.RowHeights[ARow] - TextHeight('X')) div 2, - ValEd.Cells[ACol, ARow] + // Set colours for fixed cells (non-editable) + ValEd.Canvas.Brush.Color := clBtnFace; + ValEd.Canvas.Font.Color := ValEd.Font.Color; + end + else + begin + // Set colours for editable cell + ValEd.Canvas.Brush.Color := ValEd.Color; + ValEd.Canvas.Font.Color := ValEd.Font.Color; + end; + // Colour the current cell + ValEd.Canvas.FillRect(Rect); + if gdFixed in State then + begin + // draw vertical line at right edge of fixed cell to act as border + ValEd.Canvas.Pen.Color := clBtnShadow; + ValEd.Canvas.MoveTo(Rect.Right - 1, Rect.Top); + ValEd.Canvas.LineTo(Rect.Right - 1, Rect.Bottom); + end; + // Display required text + ValEd.Canvas.TextOut( + Rect.Left + 2 , + Rect.Top + (ValEd.RowHeights[ARow] - ValEd.Canvas.TextHeight('X')) div 2, + ValEd.Cells[ACol, ARow] + ); + if (ACol = 0) and (ValEd.Selection.Top = ARow) then + begin + // This is a fixed cell which has selected editable cell adjacent to it + // draw an arrow at the RHS of this cell that points to selected cell + ValEd.Canvas.Pen.Color := clHighlight; + GraphUtil.DrawArrow( + ValEd.Canvas, + sdRight, + Point(Rect.Right - 8, (Rect.Top + Rect.Bottom) div 2 - 4), 4 ); - if (ACol = 0) and (ValEd.Selection.Top = ARow) then - begin - // This is a fixed cell which has selected editable cell adjacent to it - // draw an arrow at the RHS of this cell that points to selected cell - Pen.Color := clHighlight; - GraphUtil.DrawArrow( - ValEd.Canvas, - sdRight, - Point(Rect.Right - 8, (Rect.Top + Rect.Bottom) div 2 - 4), 4 - ); - end; end; end; diff --git a/Src/FmCompilersDlg.FrNamespaces.pas b/Src/FmCompilersDlg.FrNamespaces.pas index af84f7116..93fa88b58 100644 --- a/Src/FmCompilersDlg.FrNamespaces.pas +++ b/Src/FmCompilersDlg.FrNamespaces.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame used to edit namespaces used for a compiler being edited * in TCompilersDlg. diff --git a/Src/FmCompilersDlg.FrSearchDirs.pas b/Src/FmCompilersDlg.FrSearchDirs.pas index d21053ee6..57b2195d3 100644 --- a/Src/FmCompilersDlg.FrSearchDirs.pas +++ b/Src/FmCompilersDlg.FrSearchDirs.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2024, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame used to edit lists of search directories used for a * compiler being edited in TCompilersDlg. @@ -109,7 +109,10 @@ implementation // Delphi SysUtils, Windows, Graphics, // Project - UBrowseForFolderDlg, UClassHelpers, UCtrlArranger, UStrUtils; + ClassHelpers.UActions, + ClassHelpers.UControls, + ClassHelpers.UGraphics, + UBrowseForFolderDlg, UCtrlArranger, UStrUtils; {$R *.dfm} diff --git a/Src/FmCompilersDlg.FrSwitches.pas b/Src/FmCompilersDlg.FrSwitches.pas index 2c94160bd..d5c2dcf09 100644 --- a/Src/FmCompilersDlg.FrSwitches.pas +++ b/Src/FmCompilersDlg.FrSwitches.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame used to edit switches used for a compiler being edited in * TCompilersDlg. diff --git a/Src/FmCompilersDlg.UBannerMgr.pas b/Src/FmCompilersDlg.UBannerMgr.pas index ed6218d9b..4c5ad6557 100644 --- a/Src/FmCompilersDlg.UBannerMgr.pas +++ b/Src/FmCompilersDlg.UBannerMgr.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a class that manages display of a compiler name on a gradient * filled background in a paint box. diff --git a/Src/FmCompilersDlg.UCompilerListMgr.pas b/Src/FmCompilersDlg.UCompilerListMgr.pas index ae78bec5a..63ffefe0f 100644 --- a/Src/FmCompilersDlg.UCompilerListMgr.pas +++ b/Src/FmCompilersDlg.UCompilerListMgr.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a class that manages display of compiler names in an owner draw * list box. @@ -34,6 +34,8 @@ TCompilerListMgr = class(TObject) /// <summary>Reference to managed list box.</summary> /// <remarks>Must be owner draw.</remarks> fLB: TListBox; + fMapIdxToComp: TArray<TCompilerID>; + fMapCompToIdx: array[TCompilerID] of Integer; /// <summary>List of compilers to be displayed in list box.</summary> fCompilers: ICompilers; /// <summary>Reference to OnSelect event handler.</summary> @@ -87,11 +89,16 @@ implementation constructor TCompilerListMgr.Create(const LB: TListBox; const Compilers: ICompilers); +var + CompID: TCompilerID; begin inherited Create; fLB := LB; fLB.OnClick := LBClickHandler; fLB.OnDrawItem := LBDrawItemHandler; + fLB.Clear; + for CompID := Low(TCompilerID) to High(TCompilerID) do + fLB.Items.Add(''); fCompilers := Compilers; end; @@ -103,19 +110,27 @@ procedure TCompilerListMgr.DoSelect; function TCompilerListMgr.GetSelected: ICompiler; begin - Result := fCompilers[TCompilerID(fLB.ItemIndex)]; + Result := fCompilers[fMapIdxToComp[fLB.ItemIndex]]; end; procedure TCompilerListMgr.Initialise; var CompID: TCompilerID; // loops thru supported compilers + Idx: Integer; begin inherited; + // Add empty list items - one per supported compiler. Note we don't need item // text since we handle drawing of list items ourselves and get details from // compiler objects. + SetLength(fMapIdxToComp, Length(fMapCompToIdx)); + Idx := High(fMapIdxToComp); for CompID := Low(TCompilerID) to High(TCompilerID) do - fLB.Items.Add(''); + begin + fMapIdxToComp[Idx] := CompID; + fMapCompToIdx[CompID] := Idx; + Dec(Idx); + end; // Select first compiler in list and trigger selection event for it fLB.ItemIndex := 0; DoSelect; @@ -139,7 +154,7 @@ procedure TCompilerListMgr.LBDrawItemHandler(Control: TWinControl; ItemRect := Rect; // Compiler object associated with list item - Compiler := fCompilers[TCompilerID(Index)]; + Compiler := fCompilers[fMapIdxToComp[Index]]; // Use bold font if compiler available if Compiler.IsAvailable then @@ -208,7 +223,7 @@ procedure TCompilerListMgr.Refresh(Compiler: ICompiler); var InvalidRect: TRectEx; begin - InvalidRect := fLB.ItemRect(Ord(Compiler.GetID)); + InvalidRect := fLB.ItemRect(fMapCompToIdx[Compiler.GetID]); InvalidateRect(fLB.Handle, @InvalidRect, False); end; diff --git a/Src/FmCompilersDlg.dfm b/Src/FmCompilersDlg.dfm index 81e5534d8..f9155a014 100644 --- a/Src/FmCompilersDlg.dfm +++ b/Src/FmCompilersDlg.dfm @@ -1,16 +1,16 @@ inherited CompilersDlg: TCompilersDlg Caption = 'Configure Compilers' ClientHeight = 381 - ClientWidth = 524 - ExplicitWidth = 530 + ClientWidth = 588 + ExplicitWidth = 594 ExplicitHeight = 410 PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel - Width = 505 - ExplicitWidth = 505 + Width = 539 + ExplicitWidth = 539 object pbBanner: TPaintBox - Left = 135 + Left = 169 Top = 0 Width = 370 Height = 23 @@ -26,7 +26,7 @@ inherited CompilersDlg: TCompilersDlg object lbCompilers: TListBox Left = 0 Top = 0 - Width = 129 + Width = 163 Height = 292 Style = lbOwnerDrawFixed Ctl3D = True @@ -36,7 +36,7 @@ inherited CompilersDlg: TCompilersDlg TabOrder = 0 end object pcCompiler: TPageControl - Left = 135 + Left = 169 Top = 29 Width = 370 Height = 263 @@ -123,10 +123,6 @@ inherited CompilersDlg: TCompilersDlg object tsLog: TTabSheet Caption = 'Output Log' ImageIndex = 1 - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 inline frmLog: TCompilersDlgLogFrame Left = 0 Top = 0 @@ -142,13 +138,13 @@ inherited CompilersDlg: TCompilersDlg end end inherited btnHelp: TButton - TabOrder = 4 + TabOrder = 5 end inherited btnCancel: TButton - TabOrder = 3 + TabOrder = 4 end inherited btnOK: TButton - TabOrder = 2 + TabOrder = 3 OnClick = btnOKClick end object btnDetect: TButton @@ -157,7 +153,17 @@ inherited CompilersDlg: TCompilersDlg Width = 153 Height = 25 Caption = '&Detect Delphi Compilers' - TabOrder = 1 + TabOrder = 2 OnClick = btnDetectClick end + object chkStartupDetection: TCheckBox + Left = 8 + Top = 336 + Width = 417 + Height = 17 + Caption = + 'Automatically register newly installed Delphi compilers at progr' + + 'am startup' + TabOrder = 1 + end end diff --git a/Src/FmCompilersDlg.pas b/Src/FmCompilersDlg.pas index ae237b485..e78f4fd14 100644 --- a/Src/FmCompilersDlg.pas +++ b/Src/FmCompilersDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2022, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box where the user can configure the Pascal compilers * that are to be used by CodeSnip. @@ -45,6 +45,7 @@ TCompilersDlg = class(TGenericOKDlg, INoPublicConstruct) frmSearchDirs: TCompilersDlgSearchDirsFrame; tsNamespaces: TTabSheet; frmNamespaces: TCompilersDlgNamespacesFrame; + chkStartupDetection: TCheckBox; /// <summary>When Auto Detect Compilers button is clicked, sets executable /// program path for each installed compiler that can detect its own path. /// </summary> @@ -122,7 +123,13 @@ implementation uses // Project - Compilers.UCompilers, IntfCommon, UCtrlArranger, UExeFileType, UFontHelper, + Compilers.UAutoDetect, + Compilers.UCompilers, + Compilers.USettings, + IntfCommon, + UCtrlArranger, + UExeFileType, + UFontHelper, UMessageBox; @@ -142,14 +149,19 @@ procedure TCompilersDlg.ArrangeForm; ); // size dialogue and arrange inherited controls inherited; - // arrange extra button in bottom button line - btnDetect.Left := pnlBody.Left; - btnDetect.Top := btnHelp.Top; + TCtrlArranger.AlignLefts([btnDetect, chkStartupDetection], pnlBody.Left); + // place chkStartupDetection below bevel under body panel + TCtrlArranger.MoveBelow(bvlBottom, chkStartupDetection, 8); + // push buttons below chkStartupDetection + TCtrlArranger.AlignTops( + [btnDetect, btnOK, btnCancel, btnHelp], + TCtrlArranger.BottomOf(chkStartupDetection, 8) + ); + // stretch form height to accomodate insertion of chkStartupDetection + ClientHeight := TCtrlArranger.BottomOf(btnHelp, 6); end; procedure TCompilersDlg.btnDetectClick(Sender: TObject); -var - Compiler: ICompiler; // refers to each compiler resourcestring // Text displayed in confirmation box sOKToDetect = 'Detected compiler file names will overwrite any existing ' @@ -159,19 +171,14 @@ procedure TCompilersDlg.btnDetectClick(Sender: TObject); Exit; // Record any changes to current compiler UpdateCurrentCompiler; - // Loop thru all compilers attempting to detect exe files - for Compiler in fLocalCompilers do - begin - if Supports(Compiler, ICompilerAutoDetect) then + // Register any available compilers + TCompilerAutoDetect.RegisterCompilers(fLocalCompilers, + procedure (RegisteredCompiler: ICompiler) begin - if (Compiler as ICompilerAutoDetect).DetectExeFile then - begin - // Update currently displayed compiler details - if Compiler.GetID = fCurCompiler.GetID then - UpdateEditFrames; - end; - end; - end; + if RegisteredCompiler.GetID = fCurCompiler.GetID then + UpdateEditFrames; + end + ); // Redisplay compiler list and current compiler title to reflect any changes fCompListMgr.Refresh; fBannerMgr.Refresh; @@ -234,20 +241,24 @@ class function TCompilersDlg.Execute(AOwner: TComponent; const ACompilers: ICompilers): Boolean; var Persister: IPersistCompilers; // object used to save object to storage + Dlg: TCompilersDlg; // dialogue box instance begin - with InternalCreate(AOwner) do - try - (fLocalCompilers as IAssignable).Assign(ACompilers); - Result := ShowModal = mrOK; - if Result then - begin - (ACompilers as IAssignable).Assign(fLocalCompilers); - Persister := TPersistCompilers.Create; - Persister.Save(ACompilers); - end; - finally - Free; + Dlg := InternalCreate(AOwner); + try + (Dlg.fLocalCompilers as IAssignable).Assign(ACompilers); + Dlg.chkStartupDetection.Checked := TCompilerSettings.PermitStartupDetection; + Result := Dlg.ShowModal = mrOK; + if Result then + begin + (ACompilers as IAssignable).Assign(Dlg.fLocalCompilers); + Persister := TPersistCompilers.Create; + Persister.Save(ACompilers); + TCompilerSettings.PermitStartupDetection := + Dlg.chkStartupDetection.Checked; end; + finally + Dlg.Free; + end; end; procedure TCompilersDlg.FormCreate(Sender: TObject); diff --git a/Src/FmDBUpdateDlg.pas b/Src/FmDBUpdateDlg.pas index 6dc03f72f..1ffc7347f 100644 --- a/Src/FmDBUpdateDlg.pas +++ b/Src/FmDBUpdateDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a wizard dialogue box that handles the updating of the main * DelphiDabbler Code Snippets database. @@ -254,11 +254,9 @@ procedure TDBUpdateDlg.BuildCSS(Sender: TObject; begin inherited; // Create .framed border style - with CSSBuilder.AddSelector('.framed') do - begin - AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); - AddProperty(TCSS.PaddingProp(4)); - end; + CSSBuilder.AddSelector('.framed') + .AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)) + .AddProperty(TCSS.PaddingProp(4)); end; procedure TDBUpdateDlg.ConfigForm; @@ -347,14 +345,16 @@ procedure TDBUpdateDlg.DoUpdate; end; class function TDBUpdateDlg.Execute(AOwner: TComponent): Boolean; +var + Dlg: TDBUpdateDlg; begin - with InternalCreate(AOwner) do - try - ShowModal; - Result := fDataUpdated; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.ShowModal; + Result := Dlg.fDataUpdated; + finally + Dlg.Free; + end; end; procedure TDBUpdateDlg.FormCreate(Sender: TObject); diff --git a/Src/FmDeleteCategoryDlg.pas b/Src/FmDeleteCategoryDlg.pas index 3e3ea01da..3f6a65b0f 100644 --- a/Src/FmDeleteCategoryDlg.pas +++ b/Src/FmDeleteCategoryDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that permits user to select and delete a user * defined category. @@ -137,14 +137,16 @@ class function TDeleteCategoryDlg.Execute(AOwner: TComponent; @param AOwner [in] Component that owns dialog box. @param CatList [in] List of categories available for deletion. } +var + Dlg: TDeleteCategoryDlg; begin - with InternalCreate(AOwner) do - try - fCategories := CatList; - Result := ShowModal = mrOK; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fCategories := CatList; + Result := Dlg.ShowModal = mrOK; + finally + Dlg.Free; + end; end; procedure TDeleteCategoryDlg.SelectionChangeHandler(Sender: TObject); diff --git a/Src/FmDeleteUserDBDlg.dfm b/Src/FmDeleteUserDBDlg.dfm new file mode 100644 index 000000000..1bd52b82a --- /dev/null +++ b/Src/FmDeleteUserDBDlg.dfm @@ -0,0 +1,48 @@ +inherited DeleteUserDBDlg: TDeleteUserDBDlg + Caption = 'Delete User Database' + ExplicitWidth = 474 + ExplicitHeight = 375 + PixelsPerInch = 96 + TextHeight = 13 + inherited pnlBody: TPanel + object edConfirm: TEdit + Left = 0 + Top = 216 + Width = 201 + Height = 21 + TabOrder = 0 + end + inline frmWarning: TFixedHTMLDlgFrame + Left = 0 + Top = 0 + Width = 369 + Height = 210 + Align = alTop + TabOrder = 1 + TabStop = True + ExplicitWidth = 369 + ExplicitHeight = 210 + inherited pnlBrowser: TPanel + Width = 369 + Height = 210 + ExplicitWidth = 369 + ExplicitHeight = 210 + inherited wbBrowser: TWebBrowser + Width = 369 + Height = 210 + ExplicitWidth = 369 + ExplicitHeight = 210 + ControlData = { + 4C00000023260000B41500000000000000000000000000000000000000000000 + 000000004C000000000000000000000001000000E0D057007335CF11AE690800 + 2B2E126208000000000000004C0000000114020000000000C000000000000046 + 8000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000100000000000000000000000000000000000000} + end + end + end + end + inherited btnOK: TButton + OnClick = btnOKClick + end +end diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/FmDeleteUserDBDlg.pas new file mode 100644 index 000000000..d51be0681 --- /dev/null +++ b/Src/FmDeleteUserDBDlg.pas @@ -0,0 +1,111 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2022-2023, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements a dialogue box that asks user to confirm deletion of user-defined + * snippets database. +} + + +unit FmDeleteUserDBDlg; + +interface + +uses + // Delphi + Forms, StdCtrls, Controls, ExtCtrls, Classes, + // Project + FmGenericOKDlg, + FrBrowserBase, FrHTMLDlg, FrFixedHTMLDlg, + UBaseObjects; + +type + TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) + edConfirm: TEdit; + frmWarning: TFixedHTMLDlgFrame; + procedure btnOKClick(Sender: TObject); + strict private + const + cConfirmText = 'DELETE MY SNIPPETS'; + var + fPermissionGranted: Boolean; + strict protected + /// <summary>Protected constructor that sets up form.</summary> + constructor InternalCreate(AOwner: TComponent); override; + procedure ConfigForm; override; + procedure ArrangeForm; override; + function IsValidPassword: Boolean; + public + class function Execute(AOwner: TComponent): Boolean; + end; + +implementation + +uses + // Delphi + SysUtils, + // Project + UCtrlArranger, UMessageBox; + +{$R *.dfm} + +procedure TDeleteUserDBDlg.ArrangeForm; +begin + frmWarning.Height := frmWarning.DocHeight; + edConfirm.Left := 0; + TCtrlArranger.MoveBelow(frmWarning, edConfirm, 12); + TCtrlArranger.AlignHCentresTo([frmWarning], [edConfirm]); + pnlBody.ClientHeight := TCtrlArranger.TotalControlHeight(pnlBody) + 8; + inherited; +end; + +procedure TDeleteUserDBDlg.btnOKClick(Sender: TObject); +resourcestring + sBadPassword = 'Invalid confirmation text entered'; +begin + inherited; + fPermissionGranted := IsValidPassword; + if not fPermissionGranted then + begin + TMessageBox.Error(Self, sBadPassword); + edConfirm.Text := ''; + ModalResult := mrNone; + end; +end; + +procedure TDeleteUserDBDlg.ConfigForm; +begin + inherited; +// frmWarning.OnBuildCSS := BuildCSS; + frmWarning.Initialise('dlg-dbdelete.html'); +end; + +class function TDeleteUserDBDlg.Execute(AOwner: TComponent): Boolean; +var + Dlg: TDeleteUserDBDlg; +begin + Dlg := InternalCreate(AOwner); + try + Dlg.ShowModal; + Result := Dlg.fPermissionGranted; + finally + Dlg.Free; + end; +end; + +constructor TDeleteUserDBDlg.InternalCreate(AOwner: TComponent); +begin + Assert(Supports(Self, INoPublicConstruct), ClassName + '.InternalCreate: ' + + 'Form''s protected constructor can''t be called'); + inherited InternalCreate(AOwner); +end; + +function TDeleteUserDBDlg.IsValidPassword: Boolean; +begin + Result := edConfirm.Text = cConfirmText; +end; + +end. diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index be2480ace..e1705a01e 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that displays all the dependencies and dependents * of a snippet. @@ -321,43 +321,47 @@ procedure TDependenciesDlg.DisplayCircularRefWarning; class function TDependenciesDlg.Execute(const AOwner: TComponent; const Snippet: TSnippet; const Tabs: TTabIDs; const PermitSelection: Boolean; const AHelpKeyword: string): ISearch; +var + Dlg: TDependenciesDlg; begin Assert(Tabs <> [], ClassName + '.Execute: Tabs is []'); - with InternalCreate(AOwner) do - try - fSnippetID := Snippet.ID; - fDisplayName := Snippet.DisplayName; - fDependsList := Snippet.Depends; - fTabs := Tabs; - fCanSelect := PermitSelection; - HelpKeyword := AHelpKeyword; - if ShowModal = mrOK then - Result := fSearch - else - Result := nil; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fSnippetID := Snippet.ID; + Dlg.fDisplayName := Snippet.DisplayName; + Dlg.fDependsList := Snippet.Depends; + Dlg.fTabs := Tabs; + Dlg.fCanSelect := PermitSelection; + Dlg.HelpKeyword := AHelpKeyword; + if Dlg.ShowModal = mrOK then + Result := Dlg.fSearch + else + Result := nil; + finally + Dlg.Free; + end; end; class procedure TDependenciesDlg.Execute(const AOwner: TComponent; const SnippetID: TSnippetID; const DisplayName: string; const DependsList: TSnippetList; const Tabs: TTabIDs; const AHelpKeyword: string); +var + Dlg: TDependenciesDlg; begin Assert(Tabs <> [], ClassName + '.Execute: Tabs is []'); - with InternalCreate(AOwner) do - try - fSnippetID := SnippetID; - fDisplayName := DisplayName; - fDependsList := DependsList; - fTabs := Tabs; - fCanSelect := False; - HelpKeyword := AHelpKeyword; - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fSnippetID := SnippetID; + Dlg.fDisplayName := DisplayName; + Dlg.fDependsList := DependsList; + Dlg.fTabs := Tabs; + Dlg.fCanSelect := False; + Dlg.HelpKeyword := AHelpKeyword; + Dlg.ShowModal; + finally + Dlg.Free; + end; end; procedure TDependenciesDlg.FormDestroy(Sender: TObject); diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 878f84d1a..4c207e683 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box which can create a duplicate copy of asnippet. } @@ -137,18 +137,20 @@ function TDuplicateSnippetDlg.DisallowedNames: IStringList; class function TDuplicateSnippetDlg.Execute(const AOwner: TComponent; const ASnippet: TSnippet): Boolean; +var + Dlg: TDuplicateSnippetDlg; resourcestring sCaption = 'Duplicate %s'; // dialog box caption begin Assert(Assigned(ASnippet), ClassName + '.Execute: ASnippet is nil'); - with InternalCreate(AOwner) do - try - Caption := Format(sCaption, [ASnippet.DisplayName]); - fSnippet := ASnippet; - Result := ShowModal = mrOK; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.Caption := Format(sCaption, [ASnippet.DisplayName]); + Dlg.fSnippet := ASnippet; + Result := Dlg.ShowModal = mrOK; + finally + Dlg.Free; + end; end; procedure TDuplicateSnippetDlg.HandleException(const E: Exception); diff --git a/Src/FmEasterEgg.pas b/Src/FmEasterEgg.pas index 19fddd207..31bdf2b38 100644 --- a/Src/FmEasterEgg.pas +++ b/Src/FmEasterEgg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Defines a form that hosts the program's easter egg. } @@ -107,13 +107,15 @@ class procedure TEasterEggForm.Execute(const AOwner: TComponent); {Displays easter egg modally. @param AOwner [in] Component that owns this form. } +var + EggForm: TEasterEggForm; begin - with Create(AOwner) do - try - ShowModal; - finally - Free; - end; + EggForm := Create(AOwner); + try + EggForm.ShowModal; + finally + EggForm.Free; + end; end; procedure TEasterEggForm.FormClose(Sender: TObject; var Action: TCloseAction); diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index a3461c20e..7213d1852 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that displays and manages the user's favourite * snippets. @@ -406,39 +406,38 @@ procedure TFavouritesDlg.ConfigForm; end; procedure TFavouritesDlg.CreateLV; + + procedure AddColumn(const ACaption: string; const AWidth: Integer); + var + Col: TListColumn; + begin + Col := fLVFavs.Columns.Add; + Col.Caption := ACaption; + Col.Width := AWidth; + end; + resourcestring sSnippetName = 'Snippet'; sLastAccessed = 'Last used'; begin fLVFavs := TListViewEx.Create(Self); - with fLVFavs do - begin - Parent := pnlBody; - Height := 240; - Width := 360; - HideSelection := False; - ReadOnly := True; - RowSelect := True; - TabOrder := 0; - TabStop := True; - ViewStyle := vsReport; - SortImmediately := False; - with Columns.Add do - begin - Caption := sSnippetName; - Width := 180; - end; - with Columns.Add do - begin - Caption := sLastAccessed; - Width := 140; - end; - OnDblClick := LVDoubleClick; - OnCompare := LVFavouritesCompare; - OnCreateItemClass := LVFavouriteCreateItemClass; - OnCustomDrawItem := LVCustomDrawItem; - OnCustomDrawSubItem := LVCustomDrawSubItem; - end; + fLVFavs.Parent := pnlBody; + fLVFavs.Height := 240; + fLVFavs.Width := 360; + fLVFavs.HideSelection := False; + fLVFavs.ReadOnly := True; + fLVFavs.RowSelect := True; + fLVFavs.TabOrder := 0; + fLVFavs.TabStop := True; + fLVFavs.ViewStyle := vsReport; + fLVFavs.SortImmediately := False; + AddColumn(sSnippetName, 180); + AddColumn(sLastAccessed, 140); + fLVFavs.OnDblClick := LVDoubleClick; + fLVFavs.OnCompare := LVFavouritesCompare; + fLVFavs.OnCreateItemClass := LVFavouriteCreateItemClass; + fLVFavs.OnCustomDrawItem := LVCustomDrawItem; + fLVFavs.OnCustomDrawSubItem := LVCustomDrawSubItem; end; class procedure TFavouritesDlg.Display(AOwner: TComponent; diff --git a/Src/FmFindCompilerDlg.dfm b/Src/FmFindCompilerDlg.dfm index c34a479f7..ccf79cd44 100644 --- a/Src/FmFindCompilerDlg.dfm +++ b/Src/FmFindCompilerDlg.dfm @@ -29,8 +29,8 @@ inherited FindCompilerDlg: TFindCompilerDlg end object lbCompilerVers: TCheckListBox Left = 0 - Top = 16 - Width = 136 + Top = 19 + Width = 154 Height = 186 OnClickCheck = lbCompilerVersClickCheck IntegralHeight = True diff --git a/Src/FmFindCompilerDlg.pas b/Src/FmFindCompilerDlg.pas index 0b32b650f..958827bf5 100644 --- a/Src/FmFindCompilerDlg.pas +++ b/Src/FmFindCompilerDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that is used to select criteria for searches for * snippets that compile or don't compile with selected compilers. @@ -55,6 +55,7 @@ TFindCompilerDlg = class(TGenericOKDlg, INoPublicConstruct) fSearchParams: TCompilerSearchParams; // Persistent compiler search options fSearch: ISearch; // Search entered by user fRefinePreviousSearch: Boolean; // Whether to refine previous search + fMapIdxToComp: TArray<TCompilerID>; // Maps list idx to comp ID of entry procedure UpdateOKBtn; {Updates state of OK button according to whether valid entries made in @@ -321,15 +322,17 @@ class function TFindCompilerDlg.Execute(const AOwner: TComponent; @return True if user OKs and search object created or false if user cancels and search object is nil. } +var + Dlg: TFindCompilerDlg; begin - with InternalCreate(AOwner) do - try - Result := (ShowModal = mrOK); - ASearch := fSearch; - RefineExisting := fRefinePreviousSearch; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Result := (Dlg.ShowModal = mrOK); + ASearch := Dlg.fSearch; + RefineExisting := Dlg.fRefinePreviousSearch; + finally + Dlg.Free; + end; end; procedure TFindCompilerDlg.FormCreate(Sender: TObject); @@ -361,13 +364,25 @@ procedure TFindCompilerDlg.InitForm; Option: TCompilerSearchOption; // loops thru possible compiler search options SelOption: Integer; // selected search option Compiler: ICompiler; // references each compiler + CompID: TCompilerID; begin inherited; + // Set up index map that reverses order of compilers + SetLength(fMapIdxToComp, fCompilers.Count); + Idx := High(fMapIdxToComp); + for CompID := Low(TCompilerID) to High(TCompilerID) do + begin + fMapIdxToComp[Idx] := CompID; + Dec(Idx); + end; + // Set up list of compilers and check appropriate ones // we store compiler ID in listbox's Objects[] property - for Compiler in fCompilers do + // Use mapping to reverse order of compilers in list + for Idx := Low(fMapIdxToComp) to High(fMapIdxToComp) do begin - Idx := lbCompilerVers.Items.AddObject( + Compiler := fCompilers[fMapIdxToComp[Idx]]; + lbCompilerVers.Items.AddObject( Compiler.GetName, TObject(Compiler.GetID) ); lbCompilerVers.Checked[Idx] := Compiler.GetID in fSearchParams.Compilers; diff --git a/Src/FmFindTextDlg.pas b/Src/FmFindTextDlg.pas index e7663af37..383234cef 100644 --- a/Src/FmFindTextDlg.pas +++ b/Src/FmFindTextDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that is used to select criteria for text searches. * @@ -250,15 +250,17 @@ class function TFindTextDlg.Execute(const AOwner: TComponent; @return True if user OKs and search object created or false if user cancels and search object is nil. } +var + Dlg: TFindTextDlg; begin - with InternalCreate(AOwner) do - try - Result := (ShowModal = mrOK); - ASearch := fSearch; - RefineExisting := fRefinePreviousSearch; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Result := (Dlg.ShowModal = mrOK); + ASearch := Dlg.fSearch; + RefineExisting := Dlg.fRefinePreviousSearch; + finally + Dlg.Free; + end; end; procedure TFindTextDlg.FormCreate(Sender: TObject); diff --git a/Src/FmFindXRefsDlg.pas b/Src/FmFindXRefsDlg.pas index 7005e2b24..0d301ef98 100644 --- a/Src/FmFindXRefsDlg.pas +++ b/Src/FmFindXRefsDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that is used to select criteria for searches for * cross referenced snippets. @@ -250,16 +250,18 @@ class function TFindXRefsDlg.Execute(const AOwner: TComponent; @return True if user OKs and search object created or false if user cancels and search object is nil. } +var + Dlg: TFindXRefsDlg; begin Assert(Assigned(Snippet), ClassName + '.Execute: Snippet is nil'); - with InternalCreate(AOwner) do - try - fSnippet := Snippet; - Result := (ShowModal = mrOK); - ASearch := fSearch; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fSnippet := Snippet; + Result := (Dlg.ShowModal = mrOK); + ASearch := Dlg.fSearch; + finally + Dlg.Free; + end; end; procedure TFindXRefsDlg.FormCreate(Sender: TObject); diff --git a/Src/FmGenericDlg.pas b/Src/FmGenericDlg.pas index 96d60e57e..918ebe35c 100644 --- a/Src/FmGenericDlg.pas +++ b/Src/FmGenericDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a base class for all the program's dialogue boxes. } diff --git a/Src/FmGenericModalDlg.pas b/Src/FmGenericModalDlg.pas index 91ecf29c6..20d96f679 100644 --- a/Src/FmGenericModalDlg.pas +++ b/Src/FmGenericModalDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements an abstract base class for all the program's modal dialogue boxes. } diff --git a/Src/FmGenericNonModalDlg.pas b/Src/FmGenericNonModalDlg.pas index 17a65a1eb..647f0589a 100644 --- a/Src/FmGenericNonModalDlg.pas +++ b/Src/FmGenericNonModalDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a base class for all the program's non-modal dialogue boxes. } diff --git a/Src/FmGenericOKDlg.pas b/Src/FmGenericOKDlg.pas index 89c74f26f..6e46b618e 100644 --- a/Src/FmGenericOKDlg.pas +++ b/Src/FmGenericOKDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a base class for modal dialogue boxes that have both OK and Cancel * buttons. diff --git a/Src/FmGenericViewDlg.pas b/Src/FmGenericViewDlg.pas index c47b21aed..fddc1ad67 100644 --- a/Src/FmGenericViewDlg.pas +++ b/Src/FmGenericViewDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a base class for modal dialogue boxes that have a single Close * button. diff --git a/Src/FmHelpAware.pas b/Src/FmHelpAware.pas index 8bcab08e9..58c5ca1b0 100644 --- a/Src/FmHelpAware.pas +++ b/Src/FmHelpAware.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a base class for forms that can access topics in the help file. } diff --git a/Src/FmMain.dfm b/Src/FmMain.dfm index 0128f4c4f..5b2eab657 100644 --- a/Src/FmMain.dfm +++ b/Src/FmMain.dfm @@ -8,8 +8,8 @@ inherited MainForm: TMainForm Constraints.MinWidth = 480 Menu = mnuMain OnResize = FormResize - ExplicitWidth = 613 - ExplicitHeight = 495 + ExplicitWidth = 621 + ExplicitHeight = 503 PixelsPerInch = 96 TextHeight = 13 object sbStatusBar: TStatusBar @@ -619,6 +619,7 @@ inherited MainForm: TMainForm Hint = 'Backup user database|Backup the user-defined snippet database' ImageIndex = 33 OnExecute = actBackupDatabaseExecute + OnUpdate = ActNonEmptyUserDBUpdate end object actRestoreDatabase: TAction Category = 'Database' @@ -849,6 +850,7 @@ inherited MainForm: TMainForm 'Move user database|Move the user-defined snippet database to a n' + 'ew directory' OnExecute = actMoveUserDatabaseExecute + OnUpdate = ActNonEmptyUserDBUpdate end object actSWAGImport: TAction Category = 'Snippets' @@ -860,12 +862,31 @@ inherited MainForm: TMainForm end object actBlog: TBrowseURL Category = 'Help' - Caption = 'CodeSnip News Blog' + Caption = 'CodeSnip News On DelphiDabbler Blog' Hint = - 'Display CodeSnip news blog|Display the CodeSnip News Blog in the' + - ' default web browser' + 'Display CodeSnip news|Display the DelphiDabbler blog, containing' + + ' CodeSnip news, in the default web browser' ImageIndex = 6 end + object actDeleteUserDatabase: TAction + Category = 'Database' + Caption = 'Delete User Database...' + Hint = + 'Delete User Database|Deletes the user'#39's snippets database - USE ' + + 'WITH CAUTION' + OnExecute = actDeleteUserDatabaseExecute + OnUpdate = ActNonEmptyUserDBUpdate + end + object actSaveInfo: TAction + Category = 'File' + Caption = 'Save Snippet Information...' + Hint = + 'Save snippet information|Save information about the selected sni' + + 'ppet to file' + ShortCut = 24649 + OnExecute = actSaveInfoExecute + OnUpdate = actSaveInfoUpdate + end end object mnuMain: TMainMenu Images = ilMain @@ -876,6 +897,9 @@ inherited MainForm: TMainForm object miSaveSnippet: TMenuItem Action = actSaveSnippet end + object miSaveInfo: TMenuItem + Action = actSaveInfo + end object miSaveUnit: TMenuItem Action = actSaveUnit end @@ -1093,6 +1117,12 @@ inherited MainForm: TMainForm object miMoveUserDatabase: TMenuItem Action = actMoveUserDatabase end + object miSpacer21: TMenuItem + Caption = '-' + end + object miDeleteUserDatabase: TMenuItem + Action = actDeleteUserDatabase + end end object miCompile: TMenuItem Caption = 'Compile' @@ -1157,6 +1187,7 @@ inherited MainForm: TMainForm end end object appEvents: TApplicationEvents + OnHelp = appEventsHelp OnHint = appEventsHint Left = 291 Top = 96 diff --git a/Src/FmMain.pas b/Src/FmMain.pas index d085b8b7b..6fc09ef54 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * Application's main form. Handles the program's main window display and user * interaction. @@ -56,6 +56,7 @@ TMainForm = class(THelpAwareForm) actAddFavourite: TAction; actAddSnippet: TAction; actBackupDatabase: TAction; + actBlog: TBrowseURL; actBugReport: TAction; actCloseAllDetailsTabs: TAction; actCloseDetailsTab: TAction; @@ -69,6 +70,7 @@ TMainForm = class(THelpAwareForm) actCopySource: TAction; actDeleteCategory: TAction; actDeleteSnippet: TAction; + actDeleteUserDatabase: TAction; actDuplicateSnippet: TAction; actEditSnippet: TAction; actExit: TFileExit; @@ -125,6 +127,7 @@ TMainForm = class(THelpAwareForm) miAddFavourite: TMenuItem; miAddSnippet: TMenuItem; miBackupDatabase: TMenuItem; + miBlog: TMenuItem; miCategories: TMenuItem; miCloseAllDetailsTabs: TMenuItem; miCloseDetailsTab: TMenuItem; @@ -138,6 +141,7 @@ TMainForm = class(THelpAwareForm) miDatabase: TMenuItem; miDeleteCategory: TMenuItem; miDeleteSnippet: TMenuItem; + miDeleteUserDatabase: TMenuItem; miDuplicateSnippet: TMenuItem; miEdit: TMenuItem; miEditSnippet: TMenuItem; @@ -195,6 +199,7 @@ TMainForm = class(THelpAwareForm) miSpacer17: TMenuItem; miSpacer18: TMenuItem; miSpacer20: TMenuItem; + miSpacer21: TMenuItem; miSWAGImport: TMenuItem; miTestCompile: TMenuItem; miTools: TMenuItem; @@ -236,8 +241,8 @@ TMainForm = class(THelpAwareForm) tbSpacer7: TToolButton; tbSpacer8: TToolButton; tbTestCompile: TToolButton; - actBlog: TBrowseURL; - miBlog: TMenuItem; + miSaveInfo: TMenuItem; + actSaveInfo: TAction; /// <summary>Displays About Box.</summary> procedure actAboutExecute(Sender: TObject); /// <summary>Gets a new category from user and adds to database.</summary> @@ -294,6 +299,9 @@ TMainForm = class(THelpAwareForm) /// <summary>Attempts to delete the current user defined snippet from the /// database.</summary> procedure actDeleteSnippetExecute(Sender: TObject); + /// <summary>Requests permission then attempts to delete the user defined + /// snippets database.</summary> + procedure actDeleteUserDatabaseExecute(Sender: TObject); /// <summary>Displays a dialogue box that can be used to duplicate the /// selected snippet.</summary> procedure actDuplicateSnippetExecute(Sender: TObject); @@ -472,6 +480,11 @@ TMainForm = class(THelpAwareForm) procedure actViewTestUnitUpdate(Sender: TObject); /// <summary>Displays the Welcome page in the details pane.</summary> procedure actWelcomeExecute(Sender: TObject); + /// <summary>Handles events triggered when help system is invoked. Prevents + /// exception being raised when F1 key is pressed when a menu is dropped + /// down.</summary> + function appEventsHelp(Command: Word; Data: Integer; + var CallHelp: Boolean): Boolean; /// <summary>Handles events triggered when a control issues a hint. The /// hint is displayed in the form's status bar.</summary> procedure appEventsHint(Sender: TObject); @@ -489,6 +502,9 @@ TMainForm = class(THelpAwareForm) /// position is permitted and blocks the move if not.</summary> procedure splitVertCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); + procedure ActNonEmptyUserDBUpdate(Sender: TObject); + procedure actSaveInfoUpdate(Sender: TObject); + procedure actSaveInfoExecute(Sender: TObject); strict private var /// <summary>Object that notifies user-initiated events by triggering @@ -571,14 +587,16 @@ implementation // Delphi Windows, Graphics, // Project + ClassHelpers.UControls, + ClassHelpers.UGraphics, DB.UCategory, DB.UMain, DB.USnippet, FmSplash, FmTrappedBugReportDlg, FmWaitDlg, IntfFrameMgrs, UActionFactory, UAppInfo, - UClassHelpers, UCodeShareMgr, UCommandBars, UConsts, UCopyInfoMgr, + UCodeShareMgr, UCommandBars, UConsts, UCopyInfoMgr, UCopySourceMgr, UDatabaseLoader, UDatabaseLoaderUI, UDetailTabAction, UEditSnippetAction, UExceptions, UHelpMgr, UHistoryMenus, UKeysHelper, - UMessageBox, UNotifier, UNulDropTarget, UPrintMgr, UQuery, USaveSnippetMgr, - USaveUnitMgr, USelectionIOMgr, UUrl, UUserDBMgr, UView, UViewItemAction, - UWBExternal; + UMessageBox, UNotifier, UNulDropTarget, UPrintMgr, UQuery, USaveInfoMgr, + USaveSnippetMgr, USaveUnitMgr, USelectionIOMgr, UUrl, UUserDBMgr, UView, + UViewItemAction, UWBExternal; {$R *.dfm} @@ -615,7 +633,10 @@ procedure TMainForm.actAddSnippetExecute(Sender: TObject); procedure TMainForm.actBackupDatabaseExecute(Sender: TObject); begin + if (Database as IDatabaseEdit).Updated then + TUserDBMgr.Save(Self); TUserDBMgr.BackupDatabase(Self); + fStatusBarMgr.Update; end; procedure TMainForm.actBugReportExecute(Sender: TObject); @@ -713,6 +734,17 @@ procedure TMainForm.actDeleteSnippetExecute(Sender: TObject); // display update is handled by snippets change event handler end; +procedure TMainForm.actDeleteUserDatabaseExecute(Sender: TObject); +begin + if (Database as IDatabaseEdit).Updated then + TUserDBMgr.Save(Self); + if TUserDBMgr.DeleteDatabase then + begin + ReloadDatabase; + fStatusBarMgr.Update; + end; +end; + procedure TMainForm.actDuplicateSnippetExecute(Sender: TObject); begin TUserDBMgr.DuplicateSnippet(fMainDisplayMgr.CurrentView); @@ -890,6 +922,8 @@ procedure TMainForm.actLoadSelectionExecute(Sender: TObject); procedure TMainForm.actMoveUserDatabaseExecute(Sender: TObject); begin + if (Database as IDatabaseEdit).Updated then + TUserDBMgr.Save(Self); TUserDBMgr.MoveDatabase; end; @@ -908,6 +942,11 @@ procedure TMainForm.ActNonEmptyDBUpdate(Sender: TObject); (Sender as TAction).Enabled := not Database.Snippets.IsEmpty; end; +procedure TMainForm.ActNonEmptyUserDBUpdate(Sender: TObject); +begin + (Sender as TAction).Enabled := not Database.Snippets.IsEmpty(True); +end; + procedure TMainForm.ActOverviewTabExecute(Sender: TObject); begin // Action's Tag property specifies index of tab being selected @@ -915,13 +954,13 @@ procedure TMainForm.ActOverviewTabExecute(Sender: TObject); end; procedure TMainForm.ActOverviewTabUpdate(Sender: TObject); +var + Action: TAction; begin // Action's Tag property specifies index of tab being updated - with Sender as TAction do - begin - Checked := fMainDisplayMgr.SelectedOverviewTab = Tag; - Enabled := True; - end; + Action := (Sender as TAction); + Action.Checked := fMainDisplayMgr.SelectedOverviewTab = Tag; + Action.Enabled := True; end; procedure TMainForm.actPreferencesExecute(Sender: TObject); @@ -967,7 +1006,10 @@ procedure TMainForm.actRenameCategoryUpdate(Sender: TObject); procedure TMainForm.actRestoreDatabaseExecute(Sender: TObject); begin if TUserDBMgr.RestoreDatabase(Self) then + begin ReloadDatabase; + fStatusBarMgr.Update; + end; end; procedure TMainForm.actSaveDatabaseExecute(Sender: TObject); @@ -981,6 +1023,17 @@ procedure TMainForm.actSaveDatabaseUpdate(Sender: TObject); (Sender as TAction).Enabled := TUserDBMgr.CanSave; end; +procedure TMainForm.actSaveInfoExecute(Sender: TObject); +begin + TSaveInfoMgr.Execute(fMainDisplayMgr.CurrentView); +end; + +procedure TMainForm.actSaveInfoUpdate(Sender: TObject); +begin + (Sender as TAction).Enabled := + TSaveInfoMgr.CanHandleView(fMainDisplayMgr.CurrentView); +end; + procedure TMainForm.actSaveSelectionExecute(Sender: TObject); begin TSelectionIOMgr.SaveCurrentSelection; @@ -1182,6 +1235,19 @@ procedure TMainForm.AfterShowForm; // initialise display fMainDisplayMgr.Initialise(fWindowSettings.OverviewTab); fMainDisplayMgr.ShowWelcomePage; + // check for registerable Delphi compiler installations + if fCompileMgr.CheckForNewCompilerInstalls then + fMainDisplayMgr.Refresh; +end; + +function TMainForm.appEventsHelp(Command: Word; Data: Integer; + var CallHelp: Boolean): Boolean; +begin + // Prevent Delphi Help system from interfering! + // This prevents exception being raised when F1 is pressed over menu items + // while still allowing our custom help manager to operate. + CallHelp := False; + Result := True; end; procedure TMainForm.appEventsHint(Sender: TObject); @@ -1250,14 +1316,15 @@ procedure TMainForm.FormCreate(Sender: TObject); end; procedure TMainForm.FormDestroy(Sender: TObject); +var + EditableDB: IDatabaseEdit; begin inherited; // Save any changes to user database - with Database as IDatabaseEdit do - begin - if Updated then - Save; - end; + EditableDB := Database as IDatabaseEdit; + if EditableDB.Updated then + EditableDB.Save; + // Unhook snippets event handler Database.RemoveChangeEventHandler(DBChangeHandler); // Save window state @@ -1272,7 +1339,6 @@ procedure TMainForm.FormDestroy(Sender: TObject); // fStatusBarMgr MUST be nilled: otherwise it can be called after status bar // control has been freed and so cause AV when trying to use the control FreeAndNil(fStatusBarMgr); - end; procedure TMainForm.FormResize(Sender: TObject); @@ -1295,6 +1361,8 @@ procedure TMainForm.HandleExceptions(Sender: TObject; E: Exception); procedure TMainForm.InitForm; var WBExternal: IDispatch; // external object of browser control + ActionSetter: ISetActions; + DetailCmdBarCfg, OverviewCmdBarCfg: ICommandBarConfig; begin try inherited; @@ -1338,38 +1406,37 @@ procedure TMainForm.InitForm; // Create notifier object and assign actions triggered by its methods // note that actions created on fly are automatically freed fNotifier := TNotifier.Create; - with fNotifier as ISetActions do - begin - SetUpdateDbaseAction(actUpdateDbase); - SetDisplaySnippetAction(TActionFactory.CreateSnippetAction(Self)); - SetDisplayCategoryAction(TActionFactory.CreateCategoryAction(Self)); - SetConfigCompilersAction(actCompilers); - SetShowViewItemAction( - TActionFactory.CreateViewItemAction(Self, ActViewItemExecute) - ); - SetOverviewStyleChangeActions( - [actViewCategorised, actViewAlphabetical, actViewSnippetKinds] - ); - SetDetailPaneChangeAction( - TActionFactory.CreateDetailTabAction(Self, ActSelectDetailTabExecute) - ); - SetEditSnippetAction( - TActionFactory.CreateEditSnippetAction( - Self, ActEditSnippetByNameExecute - ) - ); - SetNewSnippetAction(actAddSnippet); - SetNewsAction(actBlog); - SetAboutBoxAction(actAbout); - end; + ActionSetter := fNotifier as ISetActions; + ActionSetter.SetUpdateDbaseAction(actUpdateDbase); + ActionSetter.SetDisplaySnippetAction( + TActionFactory.CreateSnippetAction(Self) + ); + ActionSetter.SetDisplayCategoryAction( + TActionFactory.CreateCategoryAction(Self) + ); + ActionSetter.SetConfigCompilersAction(actCompilers); + ActionSetter.SetShowViewItemAction( + TActionFactory.CreateViewItemAction(Self, ActViewItemExecute) + ); + ActionSetter.SetOverviewStyleChangeActions( + [actViewCategorised, actViewAlphabetical, actViewSnippetKinds] + ); + ActionSetter.SetDetailPaneChangeAction( + TActionFactory.CreateDetailTabAction(Self, ActSelectDetailTabExecute) + ); + ActionSetter.SetEditSnippetAction( + TActionFactory.CreateEditSnippetAction( + Self, ActEditSnippetByNameExecute + ) + ); + ActionSetter.SetNewSnippetAction(actAddSnippet); + ActionSetter.SetNewsAction(actBlog); + ActionSetter.SetAboutBoxAction(actAbout); // Customise web browser controls in Details pane WBExternal := TWBExternal.Create; - with frmDetail as IWBCustomiser do - begin - SetExternalObj(WBExternal); - SetDragDropHandler(TNulDropTarget.Create); - end; + (frmDetail as IWBCustomiser).SetExternalObj(WBExternal); + (frmDetail as IWBCustomiser).SetDragDropHandler(TNulDropTarget.Create); // Set notifier for objects that trigger notifications (WBExternal as ISetNotifier).SetNotifier(fNotifier); @@ -1407,63 +1474,60 @@ procedure TMainForm.InitForm; ); // Set up detail pane's popup menus - with frmDetail as ICommandBarConfig do - begin + DetailCmdBarCfg := frmDetail as ICommandBarConfig; // set images to use - SetImages(ilMain); + DetailCmdBarCfg.SetImages(ilMain); // detail view menus - AddAction( - TActionFactory.CreateLinkAction(Self), - [cDetailPopupMenuAnchor, cDetailPopupMenuImage] - ); - AddSpacer([cDetailPopupMenuAnchor, cDetailPopupMenuImage]); - AddAction(actViewDependencies, cDetailPopupMenuIDs); - AddSpacer(cDetailPopupMenuIDs); - AddAction(actCopyInfo, cDetailPopupMenuIDs); - AddAction(actCopySnippet, cDetailPopupMenuIDs); - AddAction(actCopySource, cDetailPopupMenuIDs); - AddSpacer(cDetailPopupMenuIDs); - AddAction(actTestCompile, cDetailPopupMenuIDs); - AddSpacer(cDetailPopupMenuIDs); - AddAction(actSaveSnippet, cDetailPopupMenuIDs); - AddAction(actPrint, cDetailPopupMenuIDs); - AddSpacer(cDetailPopupMenuIDs); - AddAction(actCopy, cDetailPopupMenuTextSelect); - AddAction(actSelectAll, cDetailPopupMenuIDs); - AddSpacer(cDetailPopupMenuIDs); - AddAction(actCloseDetailsTab, cDetailPopupMenuIDs); - // tab set menu - AddAction(actCloseDetailsTab, cDetailTabSetPopupMenu); - AddAction(actCloseUnselectedDetailsTabs, cDetailTabSetPopupMenu); - end; + DetailCmdBarCfg.AddAction( + TActionFactory.CreateLinkAction(Self), + [cDetailPopupMenuAnchor, cDetailPopupMenuImage] + ); + DetailCmdBarCfg.AddSpacer([cDetailPopupMenuAnchor, cDetailPopupMenuImage]); + DetailCmdBarCfg.AddAction(actViewDependencies, cDetailPopupMenuIDs); + DetailCmdBarCfg.AddSpacer(cDetailPopupMenuIDs); + DetailCmdBarCfg.AddAction(actCopyInfo, cDetailPopupMenuIDs); + DetailCmdBarCfg.AddAction(actCopySnippet, cDetailPopupMenuIDs); + DetailCmdBarCfg.AddAction(actCopySource, cDetailPopupMenuIDs); + DetailCmdBarCfg.AddSpacer(cDetailPopupMenuIDs); + DetailCmdBarCfg.AddAction(actTestCompile, cDetailPopupMenuIDs); + DetailCmdBarCfg.AddSpacer(cDetailPopupMenuIDs); + DetailCmdBarCfg.AddAction(actSaveSnippet, cDetailPopupMenuIDs); + DetailCmdBarCfg.AddAction(actPrint, cDetailPopupMenuIDs); + DetailCmdBarCfg.AddSpacer(cDetailPopupMenuIDs); + DetailCmdBarCfg.AddAction(actCopy, cDetailPopupMenuTextSelect); + DetailCmdBarCfg.AddAction(actSelectAll, cDetailPopupMenuIDs); + DetailCmdBarCfg.AddSpacer(cDetailPopupMenuIDs); + DetailCmdBarCfg.AddAction(actCloseDetailsTab, cDetailPopupMenuIDs); + // tab set menu + DetailCmdBarCfg.AddAction(actCloseDetailsTab, cDetailTabSetPopupMenu); + DetailCmdBarCfg.AddAction( + actCloseUnselectedDetailsTabs, cDetailTabSetPopupMenu + ); // Set up overview pane's toolbar and popup menu - with frmOverview as ICommandBarConfig do - begin - SetImages(ilMain); - // add toolbar actions (in reverse order we want them!) - AddAction(actCollapseTree, cOverviewToolBar); - AddAction(actExpandTree, cOverviewToolBar); - // add popup menu actions - AddAction(actViewDependencies, cOverviewPopupMenu); - AddSpacer(cOverviewPopupMenu); - AddAction(actCopyInfo, cOverviewPopupMenu); - AddAction(actCopySnippet, cOverviewPopupMenu); - AddAction(actCopySource, cOverviewPopupMenu); - AddSpacer(cOverviewPopupMenu); - AddAction(actSaveSnippet, cOverviewPopupMenu); - AddAction(actPrint, cOverviewPopupMenu); - AddSpacer(cOverviewPopupMenu); - AddAction(actEditSnippet, cOverviewPopupMenu); - AddSpacer(cOverviewPopupMenu); - AddAction(actCollapseNode, cOverviewPopupMenu); - AddAction(actExpandNode, cOverviewPopupMenu); - end; + OverviewCmdBarCfg := frmOverview as ICommandBarConfig; + OverviewCmdBarCfg.SetImages(ilMain); + // add toolbar actions (in reverse order we want them!) + OverviewCmdBarCfg.AddAction(actCollapseTree, cOverviewToolBar); + OverviewCmdBarCfg.AddAction(actExpandTree, cOverviewToolBar); + // add popup menu actions + OverviewCmdBarCfg.AddAction(actViewDependencies, cOverviewPopupMenu); + OverviewCmdBarCfg.AddSpacer(cOverviewPopupMenu); + OverviewCmdBarCfg.AddAction(actCopyInfo, cOverviewPopupMenu); + OverviewCmdBarCfg.AddAction(actCopySnippet, cOverviewPopupMenu); + OverviewCmdBarCfg.AddAction(actCopySource, cOverviewPopupMenu); + OverviewCmdBarCfg.AddSpacer(cOverviewPopupMenu); + OverviewCmdBarCfg.AddAction(actSaveSnippet, cOverviewPopupMenu); + OverviewCmdBarCfg.AddAction(actPrint, cOverviewPopupMenu); + OverviewCmdBarCfg.AddSpacer(cOverviewPopupMenu); + OverviewCmdBarCfg.AddAction(actEditSnippet, cOverviewPopupMenu); + OverviewCmdBarCfg.AddSpacer(cOverviewPopupMenu); + OverviewCmdBarCfg.AddAction(actCollapseNode, cOverviewPopupMenu); + OverviewCmdBarCfg.AddAction(actExpandNode, cOverviewPopupMenu); // Create object to handle compilation and assoicated UI and dialogues fCompileMgr := TMainCompileMgr.Create(Self); // auto-freed - // Set event handler for snippets database Database.AddChangeEventHandler(DBChangeHandler); diff --git a/Src/FmNewHiliterNameDlg.pas b/Src/FmNewHiliterNameDlg.pas index ded2900e5..a7fcca8e5 100644 --- a/Src/FmNewHiliterNameDlg.pas +++ b/Src/FmNewHiliterNameDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that enables the user to enter a syntax highlighter * name. @@ -122,17 +122,19 @@ procedure TNewHiliterNameDlg.cbNamesChange(Sender: TObject); class function TNewHiliterNameDlg.Execute(Owner: TComponent; const Names: array of string; out NewName: string): Boolean; +var + Dlg: TNewHiliterNameDlg; begin - with InternalCreate(Owner) do - try - fNames := TIStringList.Create(Names); - fNames.CaseSensitive := False; - Result := ShowModal = mrOK; - if Result then - NewName := fNewName; - finally - Free; - end; + Dlg := InternalCreate(Owner); + try + Dlg.fNames := TIStringList.Create(Names); + Dlg.fNames.CaseSensitive := False; + Result := Dlg.ShowModal = mrOK; + if Result then + NewName := Dlg.fNewName; + finally + Dlg.Free; + end; end; procedure TNewHiliterNameDlg.InitForm; diff --git a/Src/FmPreferencesDlg.dfm b/Src/FmPreferencesDlg.dfm index cf38aa3cf..d39f3b146 100644 --- a/Src/FmPreferencesDlg.dfm +++ b/Src/FmPreferencesDlg.dfm @@ -3,27 +3,36 @@ inherited PreferencesDlg: TPreferencesDlg Top = 138 Caption = 'Preferences' ClientHeight = 421 - ClientWidth = 462 - ExplicitWidth = 468 - ExplicitHeight = 447 + ClientWidth = 722 + ExplicitWidth = 728 + ExplicitHeight = 450 PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel - Width = 446 - Height = 377 - ExplicitWidth = 446 - ExplicitHeight = 377 + Width = 609 + Height = 353 + ExplicitWidth = 609 + ExplicitHeight = 353 object pcMain: TPageControl - Left = 0 + Left = 163 Top = 0 Width = 446 - Height = 377 - Align = alClient + Height = 353 + Align = alRight MultiLine = True + TabOrder = 1 + ExplicitHeight = 329 + end + object lbPages: TListBox + Left = 0 + Top = 0 + Width = 153 + Height = 353 + Align = alLeft + ItemHeight = 13 TabOrder = 0 - OnChange = pcMainChange - OnChanging = pcMainChanging - OnMouseDown = pcMainMouseDown + OnClick = lbPagesClick + ExplicitHeight = 329 end end inherited btnOK: TButton diff --git a/Src/FmPreferencesDlg.pas b/Src/FmPreferencesDlg.pas index 390f2cbfb..cceb5b6ce 100644 --- a/Src/FmPreferencesDlg.pas +++ b/Src/FmPreferencesDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that is used to set user preferences. } @@ -27,31 +27,19 @@ interface /// Dialog box that sets user preferences. /// </summary> /// <remarks> - /// This dialog box displays tabs for preferences frames registered with the + /// This dialog box displays pages for preferences frames registered with the /// dialog box. /// </remarks> TPreferencesDlg = class(TGenericOKDlg, INoPublicConstruct) pcMain: TPageControl; + lbPages: TListBox; /// <summary>OK button click event handler. Writes preference data to /// persistent storage.</summary> procedure btnOKClick(Sender: TObject); - /// <param>Called when current tab sheet has changed. Gets newly selected - /// page to re-initialise its controls from local preferences.</param> - /// <remarks>This enables any pages that depend on preferences that may - /// have been changed in other pages to update appropriately.</remarks> - procedure pcMainChange(Sender: TObject); - /// <summary>Called just before active tab sheet is changed. Causes page - /// about to be deselected to update local preferences with any changes. - /// </summary> - /// <remarks>We do this in case another page needs to update due to changes - /// made on current page.</remarks> - procedure pcMainChanging(Sender: TObject; var AllowChange: Boolean); - /// <summary>Handles event triggered when user clicks on one of page - /// control tabs. Ensures page control has focus.</summary> - /// <remarks>Without this fix, page control does not always get focus when - /// a tab is clicked.</remarks> - procedure pcMainMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); + /// <summary>Handles event triggered when list box is clicked or changed + /// via keyboard.</summary> + procedure lbPagesClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); strict private class var /// <summary>List of registered page frames</summary> @@ -62,6 +50,10 @@ TPreferencesDlg = class(TGenericOKDlg, INoPublicConstruct) /// <summary>Records if main UI needs to be updated to reflect changed /// preferences.</summary> fUpdateUI: Boolean; + /// <summary>Records flags to be passed to frames.</summary> + fFrameFlags: UInt64; + /// <summary>Records index of currently select tab/list item.</summary> + fCurrentPageIdx: Integer; /// <summary>Creates the required frames and displays each in a tab sheet /// within the page control.</summary> /// <param name="FrameClasses">array of TPrefsFrameClass [in] Class @@ -83,6 +75,13 @@ TPreferencesDlg = class(TGenericOKDlg, INoPublicConstruct) /// <summary>Gets reference to preferences frame on currently selected tab. /// </summary> function GetSelectedPage: TPrefsBaseFrame; + /// <summary>Selects given tab.</summary> + /// <remarks>Stores state of tab being closed and restores state of tab + /// being opened.</remarks> + procedure SelectTab(TS: TTabSheet); + /// <summary>Returns index of tab selected when dialogue box was last + /// closed or -1 if no tab recorded or tab doesn't exist.</summary> + function GetLastTabIdx: Integer; strict protected /// <summary>Gets the help A-link keyword to be used when help button /// clicked.</summary> @@ -111,7 +110,8 @@ TPreferencesDlg = class(TGenericOKDlg, INoPublicConstruct) /// <returns>Boolean. True if user clicks OK to accept changes or False if /// user cancels and no changes made.</returns> class function Execute(AOwner: TComponent; - const Pages: array of TPrefsFrameClass; out UpdateUI: Boolean): Boolean; + const Pages: array of TPrefsFrameClass; out UpdateUI: Boolean; + const Flags: UInt64 = 0): Boolean; overload; /// <summary>Displays dialog with pages for each specified preferences /// frame.</summary> @@ -122,7 +122,8 @@ TPreferencesDlg = class(TGenericOKDlg, INoPublicConstruct) /// <returns>Boolean. True if user clicks OK to accept changes or False if /// user cancels and no changes made.</returns> class function Execute(AOwner: TComponent; - const Pages: array of TPrefsFrameClass): Boolean; overload; + const Pages: array of TPrefsFrameClass; const Flags: UInt64 = 0): + Boolean; overload; /// <summary>Displays preferences dialog with all registered preference /// frames.</summary> /// <param name="AOwner">TComponent [in] Component that owns dialog. @@ -131,8 +132,8 @@ TPreferencesDlg = class(TGenericOKDlg, INoPublicConstruct) /// be updated as a result of preference changes.</param> /// <returns>Boolean. True if user clicks OK to accept changes or False if /// user cancels and no changes made.</returns> - class function Execute(AOwner: TComponent; out UpdateUI: Boolean): Boolean; - overload; + class function Execute(AOwner: TComponent; out UpdateUI: Boolean; + const Flags: UInt64 = 0): Boolean; overload; /// <summary>Displays dialogue with showing a single frame, specified by /// its class name.</summary> /// <param name="AOwner">TComponent [in] Component that owns dialog. @@ -144,7 +145,7 @@ TPreferencesDlg = class(TGenericOKDlg, INoPublicConstruct) /// <returns>Boolean. True if user clicks OK to accept changes or False if /// user cancels and no changes made.</returns> class function Execute(AOwner: TComponent; const PageClsName: string; - out UpdateUI: Boolean): Boolean; overload; + out UpdateUI: Boolean; const Flags: UInt64 = 0): Boolean; overload; /// <summary>Registers given preferences frame class for inclusion in the /// preferences dialog box.</summary> /// <remarks>Registered frames are created when the dialog box is displayed @@ -160,16 +161,17 @@ implementation Design notes ------------ - This dialog box is a multi-page preferences dialog that provides access to - each page via a tab. The dialog box does not provide an implementation of each - page of the dialog. This representation must be provided by a frame descended - from TPrefsBaseFrame. Such frames must: - (a) register themselves with the dialog box by passing their class to the + This dialogue box is a multi-page preferences dialog that provides access to + each page via a list of page names. The dialogue box does not provide an + implementation of each page. This representation must be provided by a frame + descended from TPrefsBaseFrame. Such frames must: + (a) register themselves with the dialogue box by passing their class to the TPreferencesDlg.RegisterPage class method. (b) implement all the abstract methods of TPrefsBaseFrame. - The dialog box will create registered frames when needed and host them within - a tab sheet in the main page control. + The dialogue box will create registered frames when needed and host them + within tab sheet in the main page control. It will also add the name of the + frame to a list control that is used to select the required "page". There is no need to modify this unit when a new frame is to be addded to it. } @@ -177,7 +179,8 @@ implementation uses // Project - IntfCommon; + IntfCommon, + UStrUtils; {$R *.dfm} @@ -186,7 +189,7 @@ implementation procedure TPreferencesDlg.ArrangeForm; var - Idx: Integer; // loops through all displayed tab sheets + Idx: Integer; // loops through all displayed page Frame: TPrefsBaseFrame; // references each preference frame TabSheet: TTabSheet; // references each tab sheet begin @@ -241,6 +244,10 @@ procedure TPreferencesDlg.CreatePages( Frame.Top := 4; // set tab sheet caption to frame's display name TS.Caption := Frame.DisplayName; + TS.TabVisible := False; + + // Create list box item for page + lbPages.Items.AddObject(Frame.DisplayName, TS); end; end; @@ -256,37 +263,42 @@ function TPreferencesDlg.CustomHelpKeyword: string; end; class function TPreferencesDlg.Execute(AOwner: TComponent; - const Pages: array of TPrefsFrameClass; out UpdateUI: Boolean): Boolean; + const Pages: array of TPrefsFrameClass; out UpdateUI: Boolean; + const Flags: UInt64): Boolean; +var + Dlg: TPreferencesDlg; begin - with InternalCreate(AOwner) do - try - CreatePages(Pages); - Result := ShowModal = mrOK; - if Result then - UpdateUI := fUpdateUI - else - UpdateUI := False; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fFrameFlags := Flags; + Dlg.CreatePages(Pages); + Result := Dlg.ShowModal = mrOK; + if Result then + UpdateUI := Dlg.fUpdateUI + else + UpdateUI := False; + finally + Dlg.Free; + end; end; class function TPreferencesDlg.Execute(AOwner: TComponent; - out UpdateUI: Boolean): Boolean; + out UpdateUI: Boolean; const Flags: UInt64): Boolean; begin - Result := Execute(AOwner, fPages.ToArray, UpdateUI); + Result := Execute(AOwner, fPages.ToArray, UpdateUI, Flags); end; class function TPreferencesDlg.Execute(AOwner: TComponent; - const Pages: array of TPrefsFrameClass): Boolean; + const Pages: array of TPrefsFrameClass; const Flags: UInt64): Boolean; var Dummy: Boolean; // unused UpdateUI parameters begin - Result := Execute(AOwner, Pages, Dummy); + Result := Execute(AOwner, Pages, Dummy, Flags); end; class function TPreferencesDlg.Execute(AOwner: TComponent; - const PageClsName: string; out UpdateUI: Boolean): Boolean; + const PageClsName: string; out UpdateUI: Boolean; const Flags: UInt64): + Boolean; var FrameClass: TPrefsFrameClass; begin @@ -295,6 +307,28 @@ class function TPreferencesDlg.Execute(AOwner: TComponent; Result := Execute(AOwner, [FrameClass], UpdateUI); end; +procedure TPreferencesDlg.FormDestroy(Sender: TObject); +begin + // Save current page + if Assigned(pcMain.ActivePage) then + Preferences.LastTab := MapTabSheetToPage(pcMain.ActivePage).DisplayName; + inherited; +end; + +function TPreferencesDlg.GetLastTabIdx: Integer; +var + TabName: string; + ListIdx: Integer; +begin + TabName := Preferences.LastTab; + if TabName = '' then + Exit(-1); + for ListIdx := 0 to Pred(lbPages.Count) do + if StrSameText(TabName, lbPages.Items[ListIdx]) then + Exit(ListIdx); + Result := -1; +end; + function TPreferencesDlg.GetSelectedPage: TPrefsBaseFrame; begin Result := MapTabSheetToPage(pcMain.ActivePage); @@ -302,7 +336,7 @@ function TPreferencesDlg.GetSelectedPage: TPrefsBaseFrame; procedure TPreferencesDlg.InitForm; var - TabIdx: Integer; // loops thru tabs in page control + TabIdx: Integer; // loops thru tabs in page control begin inherited; // Take local copy of global preferences. This local copy will be updated as @@ -311,9 +345,22 @@ procedure TPreferencesDlg.InitForm; fLocalPrefs := (Preferences as IClonable).Clone as IPreferences; // Display and initialise required pages for TabIdx := 0 to Pred(pcMain.PageCount) do - MapTabSheetToPage(TabIdx).LoadPrefs(fLocalPrefs); - // Select first TabSheet - pcMain.ActivePageIndex := 0; + MapTabSheetToPage(TabIdx).LoadPrefs(fLocalPrefs, fFrameFlags); + // Select last used tab sheet (or 1st if last not known) + fCurrentPageIdx := GetLastTabIdx; + if fCurrentPageIdx < 0 then + fCurrentPageIdx := 0; + pcMain.ActivePageIndex := fCurrentPageIdx; + lbPages.ItemIndex := fCurrentPageIdx; +end; + +procedure TPreferencesDlg.lbPagesClick(Sender: TObject); +begin + if lbPages.ItemIndex < 0 then + Exit; + if lbPages.ItemIndex = fCurrentPageIdx then + Exit; + SelectTab(lbPages.Items.Objects[lbPages.ItemIndex] as TTabSheet) end; class function TPreferencesDlg.MapClassNameToPageClass(const ClsName: string): @@ -351,24 +398,6 @@ function TPreferencesDlg.MapTabSheetToPage( Assert(Assigned(Result), ClassName + '.MapTabSheetToPage: Frame not found'); end; -procedure TPreferencesDlg.pcMainChange(Sender: TObject); -begin - GetSelectedPage.Activate(fLocalPrefs); -end; - -procedure TPreferencesDlg.pcMainChanging(Sender: TObject; - var AllowChange: Boolean); -begin - GetSelectedPage.Deactivate(fLocalPrefs); -end; - -procedure TPreferencesDlg.pcMainMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - if htOnItem in pcMain.GetHitTestInfoAt(X, Y) then - pcMain.SetFocus; -end; - class procedure TPreferencesDlg.RegisterPage(const FrameCls: TPrefsFrameClass); var PageIdx: Integer; // loops through all registered frames @@ -389,5 +418,14 @@ class procedure TPreferencesDlg.RegisterPage(const FrameCls: TPrefsFrameClass); fPages.Insert(InsIdx, FrameCls); end; +procedure TPreferencesDlg.SelectTab(TS: TTabSheet); +begin + Assert(Assigned(TS), ClassName + '.SelectTab: TS is nil'); + GetSelectedPage.Deactivate(fLocalPrefs); + pcMain.ActivePage := TS; + GetSelectedPage.Activate(fLocalPrefs, fFrameFlags); + fCurrentPageIdx := pcMain.ActivePageIndex; +end; + end. diff --git a/Src/FmPreviewDlg.pas b/Src/FmPreviewDlg.pas index 9b2a3f1eb..e9f924046 100644 --- a/Src/FmPreviewDlg.pas +++ b/Src/FmPreviewDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that is used to preview or display plain text, HTML * and Rich text documents. @@ -172,16 +172,18 @@ procedure TPreviewDlg.CopyToClipboard; class procedure TPreviewDlg.Execute(AOwner: TComponent; const ADocContent: TEncodedData; const ADocType: TPreviewDocType; const ADlgTitle: string); +var + Dlg: TPreviewDlg; begin - with InternalCreate(AOwner) do - try - fDlgTitle := ADlgTitle; - fDocContent := TEncodedData.Create(ADocContent); - fDocType := ADocType; - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fDlgTitle := ADlgTitle; + Dlg.fDocContent := TEncodedData.Create(ADocContent); + Dlg.fDocType := ADocType; + Dlg.ShowModal; + finally + Dlg.Free; + end; end; class function TPreviewDlg.FindParentTabSheet(const Frame: TFrame): TTabSheet; diff --git a/Src/FmPrintDlg.pas b/Src/FmPrintDlg.pas index 1270bc76d..b34cdcab0 100644 --- a/Src/FmPrintDlg.pas +++ b/Src/FmPrintDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2024, Peter Johnson (gravatar.com/delphidabbler). * * Implements a print dialogue box. } @@ -76,7 +76,8 @@ implementation // Delphi Printers, Graphics, // Project - FmPreferencesDlg, FrPrintingPrefs, UClassHelpers, UConsts, UMessageBox, + ClassHelpers.UGraphics, + FmPreferencesDlg, FrPrintingPrefs, UConsts, UMessageBox, UPageSetupDlgMgr, UPrintInfo, UStructs, UStrUtils; @@ -130,7 +131,11 @@ procedure TPrintDlg.btnPrefencesClick(Sender: TObject); sMessage = 'Your preferences will take effect the next time you start the ' + 'application'; begin - if TPreferencesDlg.Execute(Self, [TPrintingPrefsFrame]) then + if TPreferencesDlg.Execute( + Self, + [TPrintingPrefsFrame], + TPrintingPrefsFrame.MakeFrameFlag(TPrintingPrefsFrame.HideRestartMessage) + ) then begin if TMessageBox.Confirm(Self, sQuery) then begin @@ -260,13 +265,15 @@ class function TPrintDlg.Execute(const AOwner: TComponent): Boolean; @param AOwner [in] Owner of dialog box. @return True if user OKs dialog box and False if user cancels. } +var + Dlg: TPrintDlg; begin - with Create(AOwner) do - try - Result := ShowModal = mrOK; - finally - Free; - end; + Dlg := Create(AOwner); + try + Result := Dlg.ShowModal = mrOK; + finally + Dlg.Free; + end; end; procedure TPrintDlg.FormCreate(Sender: TObject); diff --git a/Src/FmRegisterCompilersDlg.dfm b/Src/FmRegisterCompilersDlg.dfm new file mode 100644 index 000000000..c9db2d7e4 --- /dev/null +++ b/Src/FmRegisterCompilersDlg.dfm @@ -0,0 +1,91 @@ +inherited RegisterCompilersDlg: TRegisterCompilersDlg + Caption = 'RegisterCompilersDlg' + ClientHeight = 453 + ExplicitWidth = 474 + ExplicitHeight = 482 + PixelsPerInch = 96 + TextHeight = 13 + inherited bvlBottom: TBevel + Top = 403 + ExplicitTop = 403 + end + inherited pnlBody: TPanel + Width = 433 + Height = 389 + ExplicitWidth = 433 + ExplicitHeight = 389 + object lblDesc: TLabel + Left = 0 + Top = 0 + Width = 33 + Height = 13 + Caption = 'lblDesc' + FocusControl = clbCompilers + end + object clbCompilers: TCheckListBox + Left = 0 + Top = 32 + Width = 361 + Height = 56 + IntegralHeight = True + ItemHeight = 13 + TabOrder = 0 + end + inline frmNotes: TFixedHTMLDlgFrame + Left = 0 + Top = 159 + Width = 361 + Height = 199 + TabOrder = 1 + TabStop = True + ExplicitTop = 159 + ExplicitWidth = 361 + ExplicitHeight = 199 + inherited pnlBrowser: TPanel + Width = 361 + Height = 199 + ExplicitWidth = 361 + ExplicitHeight = 199 + inherited wbBrowser: TWebBrowser + Width = 361 + Height = 199 + ExplicitWidth = 353 + ExplicitHeight = 199 + ControlData = { + 4C0000004F250000911400000000000000000000000000000000000000000000 + 000000004C000000000000000000000001000000E0D057007335CF11AE690800 + 2B2E126208000000000000004C0000000114020000000000C000000000000046 + 8000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000100000000000000000000000000000000000000} + end + end + end + object chkDontShowAgain: TCheckBox + Left = 0 + Top = 372 + Width = 145 + Height = 17 + Caption = '&Don'#39't show this again' + TabOrder = 2 + end + end + inherited btnHelp: TButton + Left = 362 + Top = 420 + ExplicitLeft = 362 + ExplicitTop = 420 + end + inherited btnCancel: TButton + Left = 282 + Top = 420 + ExplicitLeft = 282 + ExplicitTop = 420 + end + inherited btnOK: TButton + Left = 201 + Top = 420 + Default = False + ExplicitLeft = 201 + ExplicitTop = 420 + end +end diff --git a/Src/FmRegisterCompilersDlg.pas b/Src/FmRegisterCompilersDlg.pas new file mode 100644 index 000000000..05c897c49 --- /dev/null +++ b/Src/FmRegisterCompilersDlg.pas @@ -0,0 +1,250 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2022, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements a dialogue box that is optionally displayed at start-up when + * Delphi compiler(s) are installed but not registered with CodeSnip. Allows the + * user to specify which, if any, compiler(s) are to be registered. +} + + +unit FmRegisterCompilersDlg; + +interface + +uses + // Delphi + Forms, + Classes, + StdCtrls, + Controls, + CheckLst, + ExtCtrls, + SysUtils, + // Project + FmGenericOKDlg, + FrBrowserBase, + FrFixedHTMLDlg, + FrHTMLDlg, + Compilers.UCompilers, + Compilers.UGlobals, + UBaseObjects, + UCSSBuilder; + +type + TRegisterCompilersDlg = class(TGenericOKDlg, INoPublicConstruct) + lblDesc: TLabel; + clbCompilers: TCheckListBox; + frmNotes: TFixedHTMLDlgFrame; + chkDontShowAgain: TCheckBox; + procedure FormDestroy(Sender: TObject); + procedure alMainUpdate(Action: TBasicAction; var Handled: Boolean); + strict private + var + fCandidateCompilers: TCompilerList; + fSelectedCompilers: TCompilerList; + function CountTickedCompilers: Integer; + procedure StoreSelectedCompilers; + procedure SetCaptions; + procedure PopulateList; + strict protected + procedure ConfigForm; override; + procedure InitForm; override; + procedure ArrangeForm; override; + /// <summary>Handles HTML frame's OnBuildCSS event. Adds additional CSS + /// required by HTML in this form.</summary> + /// <param name="Sender">TObject [in] Reference to object triggering event. + /// </param> + /// <param name="CSSBuilder">TCSSBuilder [in] Object used to construct the + /// CSS.</param> + procedure BuildCSS(Sender: TObject; const CSSBuilder: TCSSBuilder); + public + class function Execute(const AOwner: TComponent; + const CandidateCompilers: TCompilerList; + const SelectedCompilers: TCompilerList): Boolean; + end; + +implementation + +uses + Compilers.USettings, + UBox, + UCSSUtils, + UCtrlArranger; + +{$R *.dfm} + +{ TRegisterCompilersDlg } + +procedure TRegisterCompilersDlg.alMainUpdate(Action: TBasicAction; + var Handled: Boolean); +begin + inherited; + btnOK.Enabled := chkDontShowAgain.Checked or (CountTickedCompilers > 0); +end; + +procedure TRegisterCompilersDlg.ArrangeForm; +begin + TCtrlArranger.SetLabelHeight(lblDesc); + clbCompilers.Top := TCtrlArranger.BottomOf(lblDesc, 8); + frmNotes.Top := TCtrlArranger.BottomOf(clbCompilers, 0); + frmNotes.Height := frmNotes.DocHeight; + chkDontShowAgain.Top := TCtrlArranger.BottomOf(frmNotes, 8); + TCtrlArranger.AlignLefts( + [lblDesc, clbCompilers, frmNotes, chkDontShowAgain], 0 + ); + pnlBody.ClientHeight := TCtrlArranger.TotalControlHeight(pnlBody) + 8; + pnlBody.ClientWidth := TCtrlArranger.TotalControlWidth(pnlBody); + inherited; +end; + +procedure TRegisterCompilersDlg.BuildCSS(Sender: TObject; + const CSSBuilder: TCSSBuilder); +var + Selector: TCSSSelector; +begin + Selector := CSSBuilder.AddSelector('ol'); + Selector.AddProperty(TCSS.MarginProp(cssLeft, 24)); + Selector.AddProperty(TCSS.MarginProp(cssTop, 6)); + Selector.AddProperty(TCSS.MarginProp(cssBottom, 0)); + Selector.AddProperty(TCSS.PaddingProp(0)); + + Selector := CSSBuilder.AddSelector('ol li'); + Selector.AddProperty(TCSS.MarginProp(cssTop, 6)); + + Selector := CSSBuilder.AddSelector('ol li ul'); + Selector.AddProperty(TCSS.MarginProp(cssLeft, 16)); + Selector.AddProperty(TCSS.MarginProp(cssTop, 6)); + Selector.AddProperty(TCSS.MarginProp(cssBottom, 0)); + Selector.AddProperty(TCSS.PaddingProp(0)); + + Selector := CSSBuilder.AddSelector('ol li ul li'); + Selector.AddProperty(TCSS.MarginProp(cssTop, 0)); +end; + +procedure TRegisterCompilersDlg.ConfigForm; +begin + inherited; + frmNotes.OnBuildCSS := BuildCSS; + frmNotes.Initialise('dlg-register-compilers.html'); +end; + +function TRegisterCompilersDlg.CountTickedCompilers: Integer; +var + I: Integer; +begin + Result := 0; + for I := 0 to Pred(clbCompilers.Count) do + if clbCompilers.Checked[I] then + Inc(Result); +end; + +class function TRegisterCompilersDlg.Execute(const AOwner: TComponent; + const CandidateCompilers: TCompilerList; + const SelectedCompilers: TCompilerList): Boolean; +var + Dlg: TRegisterCompilersDlg; +begin + Assert(Assigned(CandidateCompilers), + ClassName + '.Execute: AvailCompilers list is nil'); + Assert(Assigned(SelectedCompilers), + ClassName + '.Execute: CompilersToReg list is nil'); + Assert(CandidateCompilers.Count > 0, + ClassName + '.Execute: AvailCompilers list must not be empty'); + + Dlg := InternalCreate(AOwner); + try + Dlg.fCandidateCompilers := CandidateCompilers; // reference to list + Dlg.fSelectedCompilers := SelectedCompilers; // reference to list + Result := Dlg.ShowModal = mrOK; + if Result then + begin + Dlg.StoreSelectedCompilers; + TCompilerSettings.PermitStartupDetection := + not Dlg.chkDontShowAgain.Checked; + end; + finally + Dlg.Free; + end; +end; + +procedure TRegisterCompilersDlg.FormDestroy(Sender: TObject); +var + Idx: Integer; +begin + // Free TBox<> objects associated with compiler list items + for Idx := Pred(clbCompilers.Count) downto 0 do + clbCompilers.Items.Objects[Idx].Free; + inherited; +end; + +procedure TRegisterCompilersDlg.InitForm; +begin + inherited; + SetCaptions; + PopulateList; +end; + +procedure TRegisterCompilersDlg.PopulateList; +var + Compiler: ICompiler; +begin + clbCompilers.Items.BeginUpdate; + try + clbCompilers.Clear; + for Compiler in fCandidateCompilers do + begin + clbCompilers.Items.AddObject( + Compiler.GetName, + TBox<ICompiler>.Create(Compiler) + ); + end; + finally + clbCompilers.Items.EndUpdate; + end; + Assert(clbCompilers.Count > 0, + ClassName + '.PopulateList: compiler list empty'); + clbCompilers.ItemIndex := 0; +end; + +procedure TRegisterCompilersDlg.SetCaptions; +resourcestring + sFormCaptionS = 'Unregistered Delphi Installations Detected'; + sFormCaptionP = 'Unregistered Delphi Installation Detected'; + sDescS = '&Unregistered compiler. Tick to register:'; + sDescP = '&Unregistered compilers. Tick the ones to be registered:'; +begin + // Set form and description captions + if fCandidateCompilers.Count = 1 then + begin + Caption := sFormCaptionS; + lblDesc.Caption := sDescS; + end + else + begin + // fCandidateCompilers.Count > 1 because fCandidateCompilers.Count > 0 assured by + // assertions in Execute method + Caption := sFormCaptionP; + lblDesc.Caption := sDescP; + end; +end; + +procedure TRegisterCompilersDlg.StoreSelectedCompilers; +var + I: Integer; +begin + fSelectedCompilers.Clear; + for I := 0 to Pred(clbCompilers.Count) do + if clbCompilers.Checked[I] then + begin + fSelectedCompilers.Add( + TBox<ICompiler>(clbCompilers.Items.Objects[I]).Value + ); + end; +end; + +end. + diff --git a/Src/FmRenameCategoryDlg.pas b/Src/FmRenameCategoryDlg.pas index 3db447920..039d6905a 100644 --- a/Src/FmRenameCategoryDlg.pas +++ b/Src/FmRenameCategoryDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that permits user to select and rename a user * defined category. @@ -182,14 +182,16 @@ class function TRenameCategoryDlg.Execute(AOwner: TComponent; @param AOwner [in] Component that owns dialog box. @param CatList [in] List of categories available for renaming. } +var + Dlg: TRenameCategoryDlg; begin - with InternalCreate(AOwner) do - try - fCategories := CatList; - Result := ShowModal = mrOK; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fCategories := CatList; + Result := Dlg.ShowModal = mrOK; + finally + Dlg.Free; + end; end; procedure TRenameCategoryDlg.RenameCategory(const Category: TCategory; diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index 5adb83ee2..ffe252edc 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a wizard dialogue box that lets the user select and import * packets from the DelphiDabbler implementation of the SWAG Pascal archive as @@ -422,15 +422,13 @@ procedure TSWAGImportDlg.BuildCSS(Sender: TObject; begin inherited; // Set body text spacing - with CSSBuilder.Selectors['body'] do - AddProperty(TCSS.LineHeightProp(120)); + CSSBuilder.Selectors['body'] + .AddProperty(TCSS.LineHeightProp(120)); // Create .framed border style - with CSSBuilder.AddSelector('.framed') do - begin - AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); - AddProperty(TCSS.PaddingProp(0, 4, 4, 4)); - AddProperty(TCSS.MarginProp(cssTop, 4)); - end; + CSSBuilder.AddSelector('.framed') + .AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)) + .AddProperty(TCSS.PaddingProp(0, 4, 4, 4)) + .AddProperty(TCSS.MarginProp(cssTop, 4)); end; procedure TSWAGImportDlg.clbSelectPacketsClickCheck(Sender: TObject); @@ -570,13 +568,15 @@ procedure TSWAGImportDlg.DisplayPacketsForCategory; end; class function TSWAGImportDlg.Execute(const AOwner: TComponent): Boolean; +var + Dlg: TSWAGImportDlg; begin - with InternalCreate(AOwner) do - try - Result := ShowModal = mrOK; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Result := Dlg.ShowModal = mrOK; + finally + Dlg.Free; + end; end; function TSWAGImportDlg.GetDirNameFromEditCtrl: string; @@ -812,7 +812,7 @@ procedure TSWAGImportDlg.PreviewSelectedPacket; FullPacket.FileName, FullPacket.Title, FullPacket.Author, - StringOfChar('-', 80), + StrOfChar('-', 80), StrWindowsLineBreaks(FullPacket.SourceCode) ] ); diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index b488bdc5f..a1dcf49bc 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that enables the user to the select the snippets * that are to be displayed. @@ -194,15 +194,17 @@ class function TSelectionSearchDlg.Execute(const AOwner: TComponent; if user cancels. @return True if user OKs and false if user cancels. } +var + Dlg: TSelectionSearchDlg; begin - with InternalCreate(AOwner) do - try - SetSelectedSnippets(SelectedSnippets); - Result := (ShowModal = mrOK); - ASearch := fSearch; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.SetSelectedSnippets(SelectedSnippets); + Result := (Dlg.ShowModal = mrOK); + ASearch := Dlg.fSearch; + finally + Dlg.Free; + end; end; procedure TSelectionSearchDlg.FormCreate(Sender: TObject); diff --git a/Src/FmSnippetsEditorDlg.FrActiveTextEditor.pas b/Src/FmSnippetsEditorDlg.FrActiveTextEditor.pas index fe9fcaced..65e3f116f 100644 --- a/Src/FmSnippetsEditorDlg.FrActiveTextEditor.pas +++ b/Src/FmSnippetsEditorDlg.FrActiveTextEditor.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2023, Peter Johnson (gravatar.com/delphidabbler). * * A frame that provides an editor for entering and ammending active text, * either as plain text or in markup. @@ -129,7 +129,7 @@ function TSnippetsActiveTextEdFrame.ActiveTextToPlainText( begin // NOTE: we use IActiveText.ToString here, because there may be text not in // blocks and we want to see that: usual renderer will ignore that text. - // However all lines are trimmed and empty blanks are ingored. + // However all lines are trimmed and empty blanks are ignored. Lines := TIStringList.Create(ActiveText.ToString, EOL, False, True); Result := Lines.GetText(EOL2, False); // insert blank line between paras end; @@ -215,13 +215,14 @@ function TSnippetsActiveTextEdFrame.PlainTextToActiveText(Text: string): Paragraph: string; // each paragraph in paragraphs begin // NOTE: TSnippetExtraHelper.PlainTextToActiveText is not sufficient for use - // here since it ignores newlines and we want double newlines to separated + // here since it ignores newlines and we want double newlines to separate // paragraphs. Result := TActiveTextFactory.CreateActiveText; Text := StrTrim(Text); if Text = '' then Exit; Paragraphs := TIStringList.Create(Text, EOL2, False, True); + Result.AddElem(TActiveTextFactory.CreateActionElem(ekDocument, fsOpen)); for Paragraph in Paragraphs do begin Result.AddElem(TActiveTextFactory.CreateActionElem(ekPara, fsOpen)); @@ -230,6 +231,7 @@ function TSnippetsActiveTextEdFrame.PlainTextToActiveText(Text: string): ); Result.AddElem(TActiveTextFactory.CreateActionElem(ekPara, fsClose)); end; + Result.AddElem(TActiveTextFactory.CreateActionElem(ekDocument, fsClose)); end; procedure TSnippetsActiveTextEdFrame.Preview; @@ -255,7 +257,7 @@ procedure TSnippetsActiveTextEdFrame.SetActiveText(Value: IActiveText); SetEditMode(emREML) else SetEditMode(fDefaultEditMode); - if not Value.IsEmpty then + if Value.HasContent then begin case fEditMode of emPlainText: diff --git a/Src/FmSnippetsEditorDlg.dfm b/Src/FmSnippetsEditorDlg.dfm index c503bb258..365274c63 100644 --- a/Src/FmSnippetsEditorDlg.dfm +++ b/Src/FmSnippetsEditorDlg.dfm @@ -6,7 +6,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg ClientWidth = 738 Position = poDesigned ExplicitWidth = 744 - ExplicitHeight = 606 + ExplicitHeight = 607 PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel @@ -19,7 +19,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Top = 0 Width = 662 Height = 504 - ActivePage = tsReferences + ActivePage = tsCompileResults Align = alClient TabOrder = 0 OnChange = pcMainChange @@ -193,10 +193,6 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg object tsReferences: TTabSheet Caption = 'References' ImageIndex = 1 - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblXRefs: TLabel Left = 3 Top = 3 @@ -326,10 +322,6 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg object tsCompileResults: TTabSheet Caption = 'Compile Results' ImageIndex = 3 - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblCompilers: TLabel Left = 3 Top = 3 @@ -347,8 +339,8 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg end object lblCompResDesc: TLabel Left = 3 - Top = 405 - Width = 166 + Top = 401 + Width = 186 Height = 60 AutoSize = False Caption = @@ -359,7 +351,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg object lbCompilers: TListBox Left = 3 Top = 22 - Width = 166 + Width = 186 Height = 373 Style = lbOwnerDrawFixed ItemHeight = 28 diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index da31c6fd8..45e9bc7d7 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that enables the user to create or edit user * defined snippets. @@ -531,17 +531,19 @@ class function TSnippetsEditorDlg.AddNewSnippet(AOwner: TComponent): Boolean; is aligned. May be nil. @return True if user OKs, False if cancels. } +var + Dlg: TSnippetsEditorDlg; resourcestring sCaption = 'Add a Snippet'; // dialog box caption begin - with InternalCreate(AOwner) do - try - Caption := sCaption; - fSnippet := nil; - Result := ShowModal = mrOK; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.Caption := sCaption; + Dlg.fSnippet := nil; + Result := Dlg.ShowModal = mrOK; + finally + Dlg.Free; + end; end; procedure TSnippetsEditorDlg.ArrangeForm; @@ -710,17 +712,19 @@ class function TSnippetsEditorDlg.EditSnippet(AOwner: TComponent; @param Snippet [in] Reference to snippet to be edited. @return True if user OKs, False if cancels. } +var + Instance: TSnippetsEditorDlg; resourcestring sCaption = 'Edit Snippet'; // dialogue box caption begin - with InternalCreate(AOwner) do - try - Caption := sCaption; - fSnippet := Snippet; - Result := ShowModal = mrOK; - finally - Free; - end; + Instance := InternalCreate(AOwner); + try + Instance.Caption := sCaption; + Instance.fSnippet := Snippet; + Result := Instance.ShowModal = mrOK; + finally + Instance.Free; + end; end; procedure TSnippetsEditorDlg.FocusCtrl(const Ctrl: TWinControl); @@ -944,23 +948,20 @@ function TSnippetsEditorDlg.UpdateData: TSnippetEditData; } begin Result.Init; - with Result do - begin - if StrTrim(edName.Text) <> StrTrim(edDisplayName.Text) then - Props.DisplayName := StrTrim(edDisplayName.Text) - else - Props.DisplayName := ''; - Props.Cat := fCatList.CatID(cbCategories.ItemIndex); - Props.Kind := fSnipKindList.SnippetKind(cbKind.ItemIndex); - (Props.Desc as IAssignable).Assign(frmDescription.ActiveText); - Props.SourceCode := StrTrimRight(edSourceCode.Text); - Props.HiliteSource := chkUseHiliter.Checked; - (Props.Extra as IAssignable).Assign(frmExtra.ActiveText); - Props.CompilerResults := fCompilersLBMgr.GetCompileResults; - Refs.Units := fUnitsCLBMgr.GetCheckedUnits; - Refs.Depends := fDependsCLBMgr.GetCheckedSnippets; - Refs.XRef := fXRefsCLBMgr.GetCheckedSnippets; - end; + if StrTrim(edName.Text) <> StrTrim(edDisplayName.Text) then + Result.Props.DisplayName := StrTrim(edDisplayName.Text) + else + Result.Props.DisplayName := ''; + Result.Props.Cat := fCatList.CatID(cbCategories.ItemIndex); + Result.Props.Kind := fSnipKindList.SnippetKind(cbKind.ItemIndex); + (Result.Props.Desc as IAssignable).Assign(frmDescription.ActiveText); + Result.Props.SourceCode := StrTrimRight(edSourceCode.Text); + Result.Props.HiliteSource := chkUseHiliter.Checked; + (Result.Props.Extra as IAssignable).Assign(frmExtra.ActiveText); + Result.Props.CompilerResults := fCompilersLBMgr.GetCompileResults; + Result.Refs.Units := fUnitsCLBMgr.GetCheckedUnits; + Result.Refs.Depends := fDependsCLBMgr.GetCheckedSnippets; + Result.Refs.XRef := fXRefsCLBMgr.GetCheckedSnippets; end; procedure TSnippetsEditorDlg.UpdateReferences; diff --git a/Src/FmSplash.pas b/Src/FmSplash.pas index 6e937dff2..eb2e1c034 100644 --- a/Src/FmSplash.pas +++ b/Src/FmSplash.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2024, Peter Johnson (gravatar.com/delphidabbler). * * Implements the program's splash screen. } @@ -66,10 +66,9 @@ implementation uses // Delphi - Windows, Graphics, - // 3rd party - GIFImage, + Windows, Graphics, GIFImg, // Project + ClassHelpers.UGraphics, UAppInfo, UColours, UStructs, UWindowSettings; @@ -149,7 +148,7 @@ procedure TSplashForm.pbMainPaint(Sender: TObject); // Load and display splash screen image GIF := TGIFImage.Create; try - GIF.LoadFromResourceName(HInstance, 'SPLASHIMAGE'); + GIF.LoadFromResource(HInstance, 'SPLASHIMAGE', RT_RCDATA); Canvas.Draw(0, 0, GIF); finally GIF.Free; @@ -227,19 +226,20 @@ function TSplashAligner.GetMainFormBounds(const AForm: TCustomForm): TRectEx; } var State: TWindowState; // window state read from storage + Settings: TOwnerWindowSettings; begin // We get main form's bounds from persistent storage: we have to do this since // the splash form may be displayed before main form is aligned. // If we can't read from persistent storage or form is maximized we centre // splash form in work area. This works because main form is also centred when // storage can't be read, and maximized form takes all of work area. - with TOwnerWindowSettings.Create(AForm) do - try - if not GetWdwState(Result, State) or (State = wsMaximized) then - Result := Screen.WorkAreaRect; // we use workarea of primary monitor - finally - Free; - end; + Settings := TOwnerWindowSettings.Create(AForm); + try + if not Settings.GetWdwState(Result, State) or (State = wsMaximized) then + Result := Screen.WorkAreaRect; // we use workarea of primary monitor + finally + Settings.Free; + end; end; { TOwnerWindowSettings } diff --git a/Src/FmTestCompileDlg.pas b/Src/FmTestCompileDlg.pas index 8a83de614..5066e2bff 100644 --- a/Src/FmTestCompileDlg.pas +++ b/Src/FmTestCompileDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2011-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box which test compiles a snippet and displays the * results. @@ -314,17 +314,19 @@ procedure TTestCompileDlg.DisplayCompileResults(const Compilers: ICompilers); class procedure TTestCompileDlg.Execute(const AOwner: TComponent; const ACompileMgr: TCompileMgr; const ASnippet: TSnippet); +var + Dlg: TTestCompileDlg; begin Assert(Assigned(ACompileMgr), ClassName + '.Execute: ACompileMgr is nil'); Assert(Assigned(ASnippet), ClassName + '.Execute: ASnippet is nil'); - with InternalCreate(AOwner) do - try - fCompileMgr := ACompileMgr; - fSnippet := ASnippet; - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fCompileMgr := ACompileMgr; + Dlg.fSnippet := ASnippet; + Dlg.ShowModal; + finally + Dlg.Free; + end; end; procedure TTestCompileDlg.FormCreate(Sender: TObject); diff --git a/Src/FmTrappedBugReportDlg.pas b/Src/FmTrappedBugReportDlg.pas index f8ff1f941..6c1412954 100644 --- a/Src/FmTrappedBugReportDlg.pas +++ b/Src/FmTrappedBugReportDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a bug report dialogue box that is displayed when unexpected * exceptions are detected. @@ -166,15 +166,17 @@ class procedure TTrappedBugReportDlg.Execute(Owner: TComponent; dialog is aligned over the active form. @param ErrorObj [in] Exception that caused dialog box to be displayed. } +var + Dlg: TTrappedBugReportDlg; begin Assert(Assigned(ErrorObj), ClassName + '.Execute: ErrorObj is nil'); - with InternalCreate(Owner) do - try - fErrorObj := ErrorObj; - ShowModal; - finally - Free; - end; + Dlg := InternalCreate(Owner); + try + Dlg.fErrorObj := ErrorObj; + Dlg.ShowModal; + finally + Dlg.Free; + end; end; procedure TTrappedBugReportDlg.GoToTracker; diff --git a/Src/FmUserBugReportDlg.pas b/Src/FmUserBugReportDlg.pas index dcb193bbe..bf180386d 100644 --- a/Src/FmUserBugReportDlg.pas +++ b/Src/FmUserBugReportDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that informs users how to report bugs. } @@ -75,13 +75,15 @@ class procedure TUserBugReportDlg.Execute(AOwner: TComponent); this component if it is a form. If Owner it is nil or not a form the dialog is aligned over the active form. } +var + Dlg: TUserBugReportDlg; begin - with Create(AOwner) do - try - ShowModal; - finally - Free; - end; + Dlg := Create(AOwner); + try + Dlg.ShowModal; + finally + Dlg.Free; + end; end; end. diff --git a/Src/FmUserDataPathDlg.pas b/Src/FmUserDataPathDlg.pas index ff110a4bc..9c6bbbbbe 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/FmUserDataPathDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that can be used to move the user database to a * different directory. @@ -272,16 +272,21 @@ procedure TUserDataPathDlg.DoMove(const NewDir: string; end; class procedure TUserDataPathDlg.Execute(AOwner: TComponent); +{$IFNDEF PORTABLE} +var + Dlg: TUserDataPathDlg; +{$ENDIF} begin {$IFDEF PORTABLE} raise EBug.Create(ClassName + '.Execute: Call forbidden in portable edition'); + {$ELSE} + Dlg := InternalCreate(AOwner); + try + Dlg.ShowModal + finally + Dlg.Free; + end; {$ENDIF} - with InternalCreate(AOwner) do - try - ShowModal - finally - Free; - end; end; procedure TUserDataPathDlg.FormCreate(Sender: TObject); diff --git a/Src/FmUserHiliterMgrDlg.pas b/Src/FmUserHiliterMgrDlg.pas index d4371034a..b71130b03 100644 --- a/Src/FmUserHiliterMgrDlg.pas +++ b/Src/FmUserHiliterMgrDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a dialogue box that manages named user defined syntax * highlighters. It lists available named highlighters which can be selected for @@ -152,16 +152,18 @@ procedure TUserHiliterMgrDlg.ArrangeForm; class function TUserHiliterMgrDlg.Execute(AOwner: TComponent; ANamedAttrs: INamedHiliteAttrs; out ASelected: IHiliteAttrs): Boolean; +var + Dlg: TUserHiliterMgrDlg; begin - with InternalCreate(AOwner) do - try - fNamedAttrs := ANamedAttrs; - Result := ShowModal = mrOK; - if Result then - ASelected := fSelected; - finally - Free; - end; + Dlg := InternalCreate(AOwner); + try + Dlg.fNamedAttrs := ANamedAttrs; + Result := Dlg.ShowModal = mrOK; + if Result then + ASelected := Dlg.fSelected; + finally + Dlg.Free; + end; end; procedure TUserHiliterMgrDlg.InitForm; diff --git a/Src/FmWaitDlg.pas b/Src/FmWaitDlg.pas index 66f35c92c..1d55ef3d1 100644 --- a/Src/FmWaitDlg.pas +++ b/Src/FmWaitDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a borderless dialogue box that displays a message. * diff --git a/Src/FmWizardDlg.pas b/Src/FmWizardDlg.pas index b4ef58cc5..a52605a9e 100644 --- a/Src/FmWizardDlg.pas +++ b/Src/FmWizardDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Base class for multi-page modal "wizard" dialogue boxes. } diff --git a/Src/FrBrowserBase.pas b/Src/FrBrowserBase.pas index 5dea1ac83..479b1c828 100644 --- a/Src/FrBrowserBase.pas +++ b/Src/FrBrowserBase.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2022, Peter Johnson (gravatar.com/delphidabbler). * * Implements a base class for all frames that contain a web browser control. } @@ -193,76 +193,56 @@ procedure TBrowserBaseFrame.BuildCSS(const CSSBuilder: TCSSBuilder); CSSFont: TFont; begin // <img> tag style: no borders - with CSSBuilder.AddSelector('img') do - AddProperty(TCSS.HideBorderProp(cssAll)); + CSSBuilder.AddSelector('img') + .AddProperty(TCSS.HideBorderProp(cssAll)); // Default <a> tag style: fall back links for unknown link classes. // Each link type is expected to define own colour as a minimum. - with CSSBuilder.AddSelector('a') do - begin - AddProperty(TCSS.ColorProp(clDefaultLink)); - AddProperty(TCSS.TextDecorationProp([ctdUnderline])); - end; + CSSBuilder.AddSelector('a') + .AddProperty(TCSS.ColorProp(clDefaultLink)) + .AddProperty(TCSS.TextDecorationProp([ctdUnderline])); // <a class="help-link"> override - with CSSBuilder.AddSelector('a.help-link') do - begin - AddProperty(TCSS.ColorProp(clHelpLink)); - end; + CSSBuilder.AddSelector('a.help-link') + .AddProperty(TCSS.ColorProp(clHelpLink)); // <a class="snippet-link"> and <a class="category-link"> overrides - with CSSBuilder.AddSelector('a.snippet-link, a.category-link') do - begin - AddProperty(TCSS.ColorProp(clDBLink)); - AddProperty(TCSS.FontStyleProp(cfsItalic)); - AddProperty(TCSS.TextDecorationProp([ctdNone])); - end; - with CSSBuilder.AddSelector('a:hover.snippet-link, a:hover.category-link') do - begin - AddProperty(TCSS.BorderProp(cssBottom, 1, cbsDotted, clDBLink)); - end; + CSSBuilder.AddSelector('a.snippet-link, a.category-link') + .AddProperty(TCSS.ColorProp(clDBLink)) + .AddProperty(TCSS.FontStyleProp(cfsItalic)) + .AddProperty(TCSS.TextDecorationProp([ctdNone])); + CSSBuilder.AddSelector('a:hover.snippet-link, a:hover.category-link') + .AddProperty(TCSS.BorderProp(cssBottom, 1, cbsDotted, clDBLink)); // <a class="command-link"> override - with CSSBuilder.AddSelector('a.command-link') do - begin - AddProperty(TCSS.ColorProp(clCommandLink)); - AddProperty(TCSS.FontStyleProp(cfsItalic)); - AddProperty(TCSS.TextDecorationProp([ctdNone])); - end; - with CSSBuilder.AddSelector('a:hover.command-link') do - begin - AddProperty(TCSS.BorderProp(cssBottom, 1, cbsDotted, clCommandLink)); - end; - with CSSBuilder.AddSelector('.no-link-decoration a:hover') do - AddProperty(TCSS.HideBorderProp(cssBottom)); + CSSBuilder.AddSelector('a.command-link') + .AddProperty(TCSS.ColorProp(clCommandLink)) + .AddProperty(TCSS.FontStyleProp(cfsItalic)) + .AddProperty(TCSS.TextDecorationProp([ctdNone])); + CSSBuilder.AddSelector('a:hover.command-link') + .AddProperty(TCSS.BorderProp(cssBottom, 1, cbsDotted, clCommandLink)); + CSSBuilder.AddSelector('.no-link-decoration a:hover') + .AddProperty(TCSS.HideBorderProp(cssBottom)); // <a class="external-link"> override - with CSSBuilder.AddSelector('a.external-link') do - begin - AddProperty(TCSS.ColorProp(clExternalLink)); - end; + CSSBuilder.AddSelector('a.external-link') + .AddProperty(TCSS.ColorProp(clExternalLink)); // <var> tag style - with CSSBuilder.AddSelector('var') do - begin - AddProperty(TCSS.ColorProp(clVarText)); - AddProperty(TCSS.FontStyleProp(cfsItalic)); - end; + CSSBuilder.AddSelector('var') + .AddProperty(TCSS.ColorProp(clVarText)) + .AddProperty(TCSS.FontStyleProp(cfsItalic)); // <code> tag style - with CSSBuilder.AddSelector('code') do - begin - CSSFont := TFont.Create; - try - TFontHelper.SetDefaultMonoFont(CSSFont); - AddProperty(TCSS.FontProps(CSSFont)); - finally - CSSFont.Free; - end; + CSSFont := TFont.Create; + try + TFontHelper.SetDefaultMonoFont(CSSFont); + CSSBuilder.AddSelector('code') + .AddProperty(TCSS.FontProps(CSSFont)); + finally + CSSFont.Free; end; // .warning class style: mainly for use inline - with CSSBuilder.AddSelector('.warning') do - begin - AddProperty(TCSS.ColorProp(clWarningText)); - AddProperty(TCSS.FontWeightProp(cfwBold)); - end; + CSSBuilder.AddSelector('.warning') + .AddProperty(TCSS.ColorProp(clWarningText)) + .AddProperty(TCSS.FontWeightProp(cfwBold)); end; function TBrowserBaseFrame.CanCopy: Boolean; diff --git a/Src/FrCategoryDescEdit.pas b/Src/FrCategoryDescEdit.pas index 62b099080..b5dd958ea 100644 --- a/Src/FrCategoryDescEdit.pas +++ b/Src/FrCategoryDescEdit.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that accepts and validates a description for a snippet * category. diff --git a/Src/FrCategoryList.pas b/Src/FrCategoryList.pas index 72b4c3a65..b1b225c97 100644 --- a/Src/FrCategoryList.pas +++ b/Src/FrCategoryList.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that displays a list of categories and provides access to * the selected category. diff --git a/Src/FrCheckedTV.pas b/Src/FrCheckedTV.pas index 169965bd4..24526d94e 100644 --- a/Src/FrCheckedTV.pas +++ b/Src/FrCheckedTV.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame containing a treeview that has check boxes associated with * tree nodes and updates parent check boxes according to state of child nodes. diff --git a/Src/FrCodeGenPrefs.pas b/Src/FrCodeGenPrefs.pas index 848f43780..06fbf58a9 100644 --- a/Src/FrCodeGenPrefs.pas +++ b/Src/FrCodeGenPrefs.pas @@ -1,13 +1,14 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2010-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2010-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that allows user to set source code generation * preferences. - * Designed for use as one of the tabs in the Preferences dialogue box. + * + * Designed for use as one of the pages in the Preferences dialogue box. } @@ -176,7 +177,8 @@ TCodeGenPrefsFrame = class(TPrefsBaseFrame) /// <summary>Records details of warnings from given preferences object and /// updates controls accordingly.</summary> /// <remarks>Called when page is activated.</remarks> - procedure Activate(const Prefs: IPreferences); override; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); + override; /// <summary>Updates given preferences object with details of warnings as /// modified by user.</summary> /// <remarks>Called when page is deactivated.</remarks> @@ -322,7 +324,8 @@ procedure TCodeGenPrefsFrame.actDeleteUpdate(Sender: TObject); actDelete.Enabled := Assigned(fLVWarnings.Selected); end; -procedure TCodeGenPrefsFrame.Activate(const Prefs: IPreferences); +procedure TCodeGenPrefsFrame.Activate(const Prefs: IPreferences; + const Flags: UInt64); begin (fWarnings as IAssignable).Assign(Prefs.Warnings); chkWARNEnabled.Checked := fWarnings.Enabled; @@ -477,6 +480,16 @@ constructor TCodeGenPrefsFrame.Create(AOwner: TComponent); end; procedure TCodeGenPrefsFrame.CreateLV; + + procedure AddColumn(const ACaption: string; const AWidth: Integer); + var + Col: TListColumn; + begin + Col := fLVWarnings.Columns.Add; + Col.Caption := ACaption; + Col.Width := AWidth; + end; + resourcestring // column header captions sSymbolColCaption = 'Symbol'; @@ -484,36 +497,21 @@ procedure TCodeGenPrefsFrame.CreateLV; sStateColCaption = 'State'; begin fLVWarnings := TListViewEx.Create(Self); - with fLVWarnings do - begin - Parent := Self; - Height := 150; - Left := 0; - HideSelection := False; - ReadOnly := True; - RowSelect := True; - TabOrder := 2; - ViewStyle := vsReport; - SortImmediately := False; - with Columns.Add do - begin - Caption := sSymbolColCaption; - Width := 240; - end; - with Columns.Add do - begin - Caption := sMinCompilerColCaption; - Width := 100; - end; - with Columns.Add do - begin - Caption := sStateColCaption; - Width := 50; - end; - OnSelectItem := LVWarningsSelected; - OnCompare := LVWarningsCompare; - OnCreateItemClass := LVWarningsCreateItemClass; - end; + fLVWarnings.Parent := Self; + fLVWarnings.Height := 150; + fLVWarnings.Left := 0; + fLVWarnings.HideSelection := False; + fLVWarnings.ReadOnly := True; + fLVWarnings.RowSelect := True; + fLVWarnings.TabOrder := 2; + fLVWarnings.ViewStyle := vsReport; + fLVWarnings.SortImmediately := False; + AddColumn(sSymbolColCaption, 240); + AddColumn(sMinCompilerColCaption, 100); + AddColumn(sStateColCaption, 50); + fLVWarnings.OnSelectItem := LVWarningsSelected; + fLVWarnings.OnCompare := LVWarningsCompare; + fLVWarnings.OnCreateItemClass := LVWarningsCreateItemClass; end; procedure TCodeGenPrefsFrame.Deactivate(const Prefs: IPreferences); @@ -682,6 +680,9 @@ procedure TCodeGenPrefsFrame.PopulatePreDefCompilerMenu; AddMenuItem('Delphi 10.2 Tokyo', 32.0); AddMenuItem('Delphi 10.3 Rio', 33.0); AddMenuItem('Delphi 10.4 Sydney', 34.0); + AddMenuItem('Delphi 11.x Alexandria', 35.0); + AddMenuItem('Delphi 12 Athens', 36.0); + AddMenuItem('Delphi 13 Florence', 37.0); end; procedure TCodeGenPrefsFrame.PreDefCompilerMenuClick(Sender: TObject); diff --git a/Src/FrDetail.pas b/Src/FrDetail.pas index 273c18a08..b090041e2 100644 --- a/Src/FrDetail.pas +++ b/Src/FrDetail.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a title frame that displays, and manages user interaction with, * the detail pane tabset. diff --git a/Src/FrDetailView.pas b/Src/FrDetailView.pas index be4ed5d4d..8aa41a592 100644 --- a/Src/FrDetailView.pas +++ b/Src/FrDetailView.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that can display detailed views. } @@ -107,7 +107,7 @@ implementation uses // Delphi - SysUtils, Graphics, Menus, + SysUtils, Graphics, Menus, Math, // Project ActiveText.UHTMLRenderer, Browser.UHighlighter, Hiliter.UAttrs, Hiliter.UCSS, Hiliter.UGlobals, UColours, UCSSUtils, UFontHelper, UPreferences, UQuery, @@ -119,105 +119,183 @@ implementation procedure TDetailViewFrame.BuildCSS(const CSSBuilder: TCSSBuilder); var - HiliteAttrs: IHiliteAttrs; // syntax highlighter used to build CSS - CSSFont: TFont; // font used to set CSS properties + HiliteAttrs: IHiliteAttrs; // syntax highlighter used to build CSS + ContentFont: TFont; // default content font sized per preferences + MonoFont: TFont; // default mono font sized per preferences + CSSFont: TFont; // font used to set CSS properties + ContentFontScaleFactor: Single; // amount to increase font size by to get + // proportionally same increase as adding 1 to + // default content font size + MonoToContentFontRatio: Single; // ratio of size of mono font to content font + DefContentFontSize: Integer; // default size of content font + DefMonoFontSize: Integer; // default size of mono font + HiliterCSS: THiliterCSS; begin // NOTE: // We only set CSS properties that may need to use system colours or fonts // that may be changed by user or changing program defaults. CSS that controls // layout remains in a CSS file embedded in resources. inherited; + ContentFont := nil; + MonoFont := nil; CSSFont := TFont.Create; try + MonoFont := TFont.Create; + ContentFont := TFont.Create; + TFontHelper.SetDefaultMonoFont(MonoFont); + TFontHelper.SetContentFont(ContentFont); + + // Must do next two lines before changing content & mono font sizes + DefContentFontSize := ContentFont.Size; + DefMonoFontSize := MonoFont.Size; + ContentFontScaleFactor := 1.0 / DefContentFontSize; + MonoToContentFontRatio := DefMonoFontSize / DefContentFontSize; + ContentFont.Size := Preferences.DetailFontSize; + MonoFont.Size := Round(ContentFont.Size * MonoToContentFontRatio); + // Set body style to use program's font and window colour - with CSSBuilder.AddSelector('body') do - begin - TFontHelper.SetContentFont(CSSFont); - AddProperty(TCSS.FontProps(CSSFont)); - AddProperty(TCSS.BackgroundColorProp(clWindow)); - end; + CSSFont.Assign(ContentFont); + CSSBuilder.AddSelector('body') + .AddProperty(TCSS.FontProps(CSSFont)) + .AddProperty(TCSS.BackgroundColorProp(clWindow)); + + // Set mono spaced font for <code> tags + CSSFont.Assign(MonoFont); + CSSBuilder.Selectors['code'] + .AddProperty(TCSS.FontProps(CSSFont)); + // Set table to use required font - with CSSBuilder.AddSelector('table') do - begin - TFontHelper.SetContentFont(CSSFont); - AddProperty(TCSS.FontProps(CSSFont)); - AddProperty(TCSS.BackgroundColorProp(clBorder)); - end; + CSSFont.Assign(ContentFont); + CSSBuilder.AddSelector('table') + .AddProperty(TCSS.FontProps(CSSFont)) + .AddProperty(TCSS.BackgroundColorProp(clBorder)); + // Set default table cell colour (must be different to table to get border) - with CSSBuilder.AddSelector('td') do - AddProperty(TCSS.BackgroundColorProp(clWindow)); + CSSBuilder.AddSelector('td') + .AddProperty(TCSS.BackgroundColorProp(clWindow)); + // Sets H1 heading font size and border - with CSSBuilder.AddSelector('h1') do - begin - TFontHelper.SetContentFont(CSSFont); - CSSFont.Size := CSSFont.Size + 2; - CSSFont.Style := [fsBold]; - AddProperty(TCSS.FontProps(CSSFont)); - AddProperty(TCSS.BorderProp(cssBottom, 1, cbsSolid, clBorder)); - end; + CSSFont.Assign(ContentFont); + CSSFont.Size := CSSFont.Size + Max( + Round(2 * ContentFontScaleFactor * CSSFont.Size), 2 + ); + CSSFont.Style := [fsBold]; + CSSBuilder.AddSelector('h1') + .AddProperty(TCSS.FontProps(CSSFont)) + .AddProperty(TCSS.BorderProp(cssBottom, 1, cbsSolid, clBorder)); + // Sets H2 heading font size and border - with CSSBuilder.AddSelector('h2') do - begin - TFontHelper.SetContentFont(CSSFont); - CSSFont.Style := [fsBold]; - AddProperty(TCSS.FontProps(CSSFont)); - end; + CSSFont.Assign(ContentFont); + CSSFont.Style := [fsBold]; + CSSBuilder.AddSelector('h2') + .AddProperty(TCSS.FontProps(CSSFont)); + // Set H2 heading font for use in rendered active text - with CSSBuilder.AddSelector('.active-text h2') do - begin - TFontHelper.SetContentFont(CSSFont); - CSSFont.Style := [fsBold]; - CSSFont.Size := CSSFont.Size + 1; - AddProperty(TCSS.FontProps(CSSFont)); - end; + CSSFont.Assign(ContentFont); + CSSFont.Style := [fsBold]; + CSSFont.Size := CSSFont.Size + Max( + Round(ContentFontScaleFactor * CSSFont.Size), 1 + ); + CSSBuilder.AddSelector('.active-text h2') + .AddProperty(TCSS.FontProps(CSSFont)); + + // Set CODE tag within H2 heading for use in rendered active text + CSSFont.Assign(MonoFont); + CSSFont.Style := [fsBold]; + CSSFont.Size := CSSFont.Size + Max( + Round(ContentFontScaleFactor * CSSFont.Size), 1 + ); + CSSBuilder.AddSelector('.active-text h2 code') + .AddProperty(TCSS.FontProps(CSSFont)); + // Set H2 heading font for use in rendered active text in snippet list table - with CSSBuilder.AddSelector('.snippet-list .active-text h2') do - begin - TFontHelper.SetContentFont(CSSFont); - CSSFont.Style := [fsBold]; - AddProperty(TCSS.FontProps(CSSFont)); - end; + CSSFont.Assign(ContentFont); + CSSFont.Style := [fsBold]; + CSSBuilder.AddSelector('.snippet-list .active-text h2') + .AddProperty(TCSS.FontProps(CSSFont)); + + // Set <code> within H2 heading font for use in rendered active text in + // snippet list table + CSSFont.Assign(MonoFont); + CSSFont.Style := [fsBold]; + CSSBuilder.AddSelector('.snippet-list .active-text h2 code') + .AddProperty(TCSS.FontProps(CSSFont)); + // Style of box that appears around clickable options (or actions) - with CSSBuilder.AddSelector('.optionbox') do - AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); - with CSSBuilder.AddSelector('.userdb') do - AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[True])); - with CSSBuilder.AddSelector('.maindb') do - AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[False])); + CSSBuilder.AddSelector('.optionbox') + .AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); + + // Heading colours for user & main databases + CSSBuilder.AddSelector('.userdb') + .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[True])); + CSSBuilder.AddSelector('.maindb') + .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[False])); + // Sets CSS for style of New Tab text - with CSSBuilder.AddSelector('#newtab') do - begin - TFontHelper.SetContentFont(CSSFont); - CSSFont.Size := 36; - CSSFont.Color := clNewTabText; - AddProperty(TCSS.FontProps(CSSFont)); - end; + CSSFont.Assign(ContentFont); + CSSFont.Size := 36 + Round(36 * ContentFontScaleFactor); + CSSFont.Color := clNewTabText; + CSSBuilder.AddSelector('#newtab') + .AddProperty(TCSS.FontProps(CSSFont)); + // Sets text styles and colours used by syntax highlighter HiliteAttrs := THiliteAttrsFactory.CreateUserAttrs; - with THiliterCSS.Create(HiliteAttrs) do - try - BuildCSS(CSSBuilder); - finally - Free; - end; - // Adjust .pas-source class to use required background colour - with CSSBuilder.Selectors['.' + THiliterCSS.GetMainCSSClassName] do - begin - AddProperty(TCSS.BackgroundColorProp(Preferences.SourceCodeBGcolour)); - if TIEInfo.SupportsCSSOverflowX then - AddProperty(TCSS.OverflowProp(covAuto, codX)); + HiliterCSS := THiliterCSS.Create(HiliteAttrs); + try + HiliterCSS.BuildCSS(CSSBuilder); + finally + HiliterCSS.Free; end; + + // Adjust .pas-source class to use required background colour + CSSBuilder.Selectors['.' + THiliterCSS.GetMainCSSClassName] + .AddProperty(TCSS.BackgroundColorProp(Preferences.SourceCodeBGcolour)) + .AddPropertyIf( + TIEInfo.SupportsCSSOverflowX, TCSS.OverflowProp(covAuto, codX) + ); + + // Address IE peculiarities if TIEInfo.SupportsCSSOverflowX then - begin - with CSSBuilder.AddSelector('#compile-results') do - AddProperty(TCSS.OverflowProp(covAuto, codX)); - end; - with CSSBuilder.AddSelector('.comptable th') do - begin - AddProperty(TCSS.BackgroundColorProp(clCompTblHeadBg)); - AddProperty(TCSS.FontWeightProp(cfwNormal)); - end; + CSSBuilder.AddSelector('#compile-results') + .AddProperty(TCSS.OverflowProp(covAuto, codX)); + + // Compiler table heading + CSSBuilder.AddSelector('.comptable th') + .AddProperty(TCSS.BackgroundColorProp(clCompTblHeadBg)) + .AddProperty(TCSS.FontWeightProp(cfwNormal)); + + // Set active text list classes + CSSBuilder.EnsureSelector('.active-text ul') + .AddProperty(TCSS.MarginProp(cssAll, 0)) + .AddProperty(TCSS.MarginProp(cssTop, 4)) + .AddProperty(TCSS.PaddingProp(cssAll, 0)) + .AddProperty(TCSS.PaddingProp(cssLeft, 24)) + .AddProperty(TCSS.ListStylePositionProp(clspOutside)) + .AddProperty(TCSS.ListStyleTypeProp(clstDisc)); + + // Active list styling + CSSBuilder.EnsureSelector('.active-text ol') + .AddProperty(TCSS.MarginProp(cssAll, 0)) + .AddProperty(TCSS.MarginProp(cssTop, 4)) + .AddProperty(TCSS.PaddingProp(cssAll, 0)) + .AddProperty(TCSS.PaddingProp(cssLeft, 32)) + .AddProperty(TCSS.ListStylePositionProp(clspOutside)) + .AddProperty(TCSS.ListStyleTypeProp(clstDecimal)); + CSSBuilder.EnsureSelector('.active-text li') + .AddProperty(TCSS.PaddingProp(cssAll, 0)) + .AddProperty(TCSS.MarginProp(cssAll, 0)); + CSSBuilder.EnsureSelector('.active-text li ol') + .AddProperty(TCSS.MarginProp(cssTop, 0)); + CSSBuilder.EnsureSelector('.active-text li ul') + .AddProperty(TCSS.MarginProp(cssTop, 0)); + CSSBuilder.EnsureSelector('.active-text ul li') + .AddProperty(TCSS.PaddingProp(cssLeft, 8)); + CSSBuilder.EnsureSelector('.active-text ul li ol li') + .AddProperty(TCSS.PaddingProp(cssLeft, 0)); + finally + ContentFont.Free; + MonoFont.Free; CSSFont.Free; end; end; diff --git a/Src/FrDisplayPrefs.dfm b/Src/FrDisplayPrefs.dfm index 71572dce7..80a7370ef 100644 --- a/Src/FrDisplayPrefs.dfm +++ b/Src/FrDisplayPrefs.dfm @@ -32,6 +32,35 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame Height = 13 Caption = 'Background colour for &source code:' end + object lblOverviewFontSize: TLabel + Left = 16 + Top = 200 + Width = 145 + Height = 13 + Caption = 'Overview tree view &font size: ' + FocusControl = cbOverviewFontSize + end + object lblDetailFontSize: TLabel + Left = 16 + Top = 232 + Width = 105 + Height = 13 + Caption = 'Detail pane font si&ze: ' + FocusControl = cbDetailFontSize + end + object lblHiliterInfo: TLabel + Left = 16 + Top = 256 + Width = 370 + Height = 36 + Caption = + 'To change the size of the source code font use the the Syntax Hi' + + 'ghlighter options page.' + Color = clBtnFace + ParentColor = False + Transparent = True + WordWrap = True + end object cbOverviewTree: TComboBox Left = 192 Top = 2 @@ -66,4 +95,20 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame TabOrder = 3 OnClick = btnDefColoursClick end + object cbOverviewFontSize: TComboBox + Left = 192 + Top = 197 + Width = 57 + Height = 21 + TabOrder = 4 + OnChange = FontSizeChange + end + object cbDetailFontSize: TComboBox + Left = 192 + Top = 229 + Width = 57 + Height = 21 + TabOrder = 5 + OnChange = FontSizeChange + end end diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 08e053321..015d1ea02 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -1,12 +1,13 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2022, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that allows user to set application display preferences. - * Designed for use as one of the tabs in the preferences dialog box. + + * Designed for use as one of the pages in the preferences dialogue box. } @@ -34,8 +35,14 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) lblUserColour: TLabel; btnDefColours: TButton; lblSourceBGColour: TLabel; + lblOverviewFontSize: TLabel; + cbOverviewFontSize: TComboBox; + lblDetailFontSize: TLabel; + cbDetailFontSize: TComboBox; + lblHiliterInfo: TLabel; procedure chkHideEmptySectionsClick(Sender: TObject); procedure btnDefColoursClick(Sender: TObject); + procedure FontSizeChange(Sender: TObject); strict private var /// <summary>Flag indicating if changes affect UI.</summary> @@ -58,12 +65,14 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) function CreateCustomColourBox(const ColourDlg: TColorDialogEx): TColorBoxEx; procedure ColourBoxChangeHandler(Sender: TObject); + procedure PopulateFontSizeCombos; public constructor Create(AOwner: TComponent); override; {Class constructor. Sets up frame and populates controls. @param AOwner [in] Component that owns frame. } - procedure Activate(const Prefs: IPreferences); override; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); + override; {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } @@ -96,17 +105,25 @@ implementation uses // Delphi - Math, Graphics, ExtCtrls, + SysUtils, Math, Graphics, ExtCtrls, // Project - FmPreferencesDlg, UColours, UCtrlArranger, UGraphicUtils; + FmPreferencesDlg, UColours, UCtrlArranger, UFontHelper, UGraphicUtils, + UMessageBox; {$R *.dfm} +resourcestring + // Error messages + sErrBadOverviewFontSize = 'Invalid font size'; + sErrBadOverviewFontRange = 'Font size out of range. ' + + 'Enter a value between %0:d and %1:d'; + { TDisplayPrefsFrame } -procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences); +procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; + const Flags: UInt64); {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } @@ -122,6 +139,10 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences); Prefs.DBHeadingCustomColours[False].CopyTo(fMainColourDlg.CustomColors, True); Prefs.DBHeadingCustomColours[True].CopyTo(fUserColourDlg.CustomColors, True); Prefs.SourceCodeBGCustomColours.CopyTo(fSourceBGColourDlg.CustomColors, True); + cbOverviewFontSize.Tag := Prefs.OverviewFontSize; // store font size in .Tag + cbOverviewFontSize.Text := IntToStr(Prefs.OverviewFontSize); + cbDetailFontSize.Tag := Prefs.DetailFontSize; // store font size in .Tag + cbDetailFontSize.Text := IntToStr(Prefs.DetailFontSize); end; procedure TDisplayPrefsFrame.ArrangeControls; @@ -131,12 +152,16 @@ procedure TDisplayPrefsFrame.ArrangeControls; TCtrlArranger.AlignLefts( [ lblOverviewTree, chkHideEmptySections, chkSnippetsInNewTab, - lblMainColour, lblUserColour, lblSourceBGColour, btnDefColours + lblMainColour, lblUserColour, lblSourceBGColour, btnDefColours, + lblOverviewFontSize, lblDetailFontSize, lblHiliterInfo ], 0 ); TCtrlArranger.AlignLefts( - [cbOverviewTree, fMainColourBox, fUserColourBox, fSourceBGColourBox], + [ + cbOverviewTree, fMainColourBox, fUserColourBox, fSourceBGColourBox, + cbOverviewFontSize, cbDetailFontSize + ], TCtrlArranger.RightOf( [lblOverviewTree, lblMainColour, lblUserColour, lblSourceBGColour], 8 @@ -144,24 +169,37 @@ procedure TDisplayPrefsFrame.ArrangeControls; ); TCtrlArranger.AlignVCentres(3, [lblOverviewTree, cbOverviewTree]); TCtrlArranger.MoveBelow( - [lblOverviewTree, cbOverviewTree], chkSnippetsInNewTab, 24 + [lblOverviewTree, cbOverviewTree], chkSnippetsInNewTab, 12 ); TCtrlArranger.MoveBelow(chkSnippetsInNewTab, chkHideEmptySections, 8); TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf(chkHideEmptySections, 24), + TCtrlArranger.BottomOf(chkHideEmptySections, 12), [lblMainColour, fMainColourBox] ); TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf([lblMainColour, fMainColourBox], 8), + TCtrlArranger.BottomOf([lblMainColour, fMainColourBox], 6), [lblUserColour, fUserColourBox] ); TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf([lblUserColour, fUserColourBox], 8), + TCtrlArranger.BottomOf([lblUserColour, fUserColourBox], 6), [lblSourceBGColour, fSourceBGColourBox] ); TCtrlArranger.MoveBelow( - [lblSourceBGColour, fSourceBGColourBox], btnDefColours, 12 + [lblSourceBGColour, fSourceBGColourBox], btnDefColours, 6 + ); + TCtrlArranger.AlignVCentres( + TCtrlArranger.BottomOf(btnDefColours, 12), + [lblOverviewFontSize, cbOverviewFontSize] ); + TCtrlArranger.AlignVCentres( + TCtrlArranger.BottomOf(cbOverviewFontSize, 8), + [lblDetailFontSize, cbDetailFontSize] + ); + TCtrlArranger.MoveBelow( + [lblDetailFontSize, cbDetailFontSize], lblHiliterInfo, 12 + ); + lblHiliterInfo.Width := Self.ClientWidth; + TCtrlArranger.SetLabelHeight(lblHiliterInfo); chkHideEmptySections.Width := Self.Width - 16; chkSnippetsInNewTab.Width := Self.Width - 16; end; @@ -224,6 +262,8 @@ constructor TDisplayPrefsFrame.Create(AOwner: TComponent); fSourceBGColourBox := CreateCustomColourBox(fSourceBGColourDlg); fSourceBGColourBox.TabOrder := 5; lblSourceBGColour.FocusControl := fSourceBGColourBox; + + PopulateFontSizeCombos; end; function TDisplayPrefsFrame.CreateCustomColourBox( @@ -266,6 +306,10 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); Prefs.SourceCodeBGCustomColours.CopyFrom( fSourceBGColourDlg.CustomColors, True ); + // Setting following properties to -1 causes preferences object to use their + // default font size + Prefs.OverviewFontSize := StrToIntDef(cbOverviewFontSize.Text, -1); + Prefs.DetailFontSize := StrToIntDef(cbDetailFontSize.Text, -1); end; function TDisplayPrefsFrame.DisplayName: string; @@ -279,6 +323,47 @@ function TDisplayPrefsFrame.DisplayName: string; Result := sDisplayName; end; +procedure TDisplayPrefsFrame.FontSizeChange(Sender: TObject); +var + Size: Integer; // font size entered by user + CB: TComboBox; // combo box that triggered event +begin + inherited; + Assert(Sender is TComboBox, + ClassName + '.FontSizeChange: Sender not TComboBox'); + CB := Sender as TComboBox; + // Do nothing if combo box text field cleared + if CB.Text = '' then + Exit; + if TryStrToInt(CB.Text, Size) then + begin + if TFontHelper.IsInCommonFontSizeRange(Size) then + begin + // Combo has valid value entered: update + CB.Tag := Size; + fUIChanged := True; + end + else + begin + // Font size out of range + TMessageBox.Error( + ParentForm, + Format( + sErrBadOverviewFontRange, + [TFontHelper.CommonFontSizes.Min, TFontHelper.CommonFontSizes.Max] + ) + ); + CB.Text := IntToStr(CB.Tag); + end; + end + else + begin + // Combo has invalid value: say so + TMessageBox.Error(ParentForm, sErrBadOverviewFontSize); + CB.Text := IntToStr(CB.Tag); + end; +end; + class function TDisplayPrefsFrame.Index: Byte; {Index number that determines the location of the tab containing this frame when displayed in the preferences dialog box. @@ -307,6 +392,14 @@ function TDisplayPrefsFrame.OverviewTreeStateDesc( Result := cOTSStartStates[State]; end; +procedure TDisplayPrefsFrame.PopulateFontSizeCombos; +begin + cbOverviewFontSize.Clear; + TFontHelper.ListCommonFontSizes(cbOverviewFontSize.Items); + cbDetailFontSize.Clear; + TFontHelper.ListCommonFontSizes(cbDetailFontSize.Items); +end; + procedure TDisplayPrefsFrame.SelectOverviewTreeState( const State: TOverviewStartState); {Selects combo box item associated with a overview treeview startup state. diff --git a/Src/FrEasterEgg.pas b/Src/FrEasterEgg.pas index 9a5d2ef8d..f993747b7 100644 --- a/Src/FrEasterEgg.pas +++ b/Src/FrEasterEgg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2022, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that hosts the HTML, CSS and JavaScript used to display * the program's animated easter egg. @@ -74,8 +74,8 @@ procedure TEasterEggFrame.BuildCSS(const CSSBuilder: TCSSBuilder); CSSFont := TFont.Create; try TFontHelper.SetContentFont(CSSFont); - with CSSBuilder.AddSelector('body') do - AddProperty(TCSS.FontProps(CSSFont)); + CSSBuilder.AddSelector('body') + .AddProperty(TCSS.FontProps(CSSFont)); finally FreeAndNil(CSSFont); end; diff --git a/Src/FrFixedHTMLDlg.pas b/Src/FrFixedHTMLDlg.pas index b3863ec50..89cf575b0 100644 --- a/Src/FrFixedHTMLDlg.pas +++ b/Src/FrFixedHTMLDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame containing a web browser control that displays content * loaded from an HTML resource. diff --git a/Src/FrGeneralPrefs.pas b/Src/FrGeneralPrefs.pas index 3b825acde..cfc8e7758 100644 --- a/Src/FrGeneralPrefs.pas +++ b/Src/FrGeneralPrefs.pas @@ -1,12 +1,13 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that allows user to set general application preferences. - * Designed for use as one of the tabs in the Preferences dialogue box. + * + * Designed for use as one of the pages in the Preferences dialogue box. } @@ -45,7 +46,8 @@ TGeneralPrefsFrame = class(TPrefsBaseFrame) {Class constructor. Sets up frame and populates controls. @param AOwner [in] Component that owns frame. } - procedure Activate(const Prefs: IPreferences); override; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); + override; {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } @@ -88,7 +90,8 @@ implementation { TGeneralPrefsFrame } -procedure TGeneralPrefsFrame.Activate(const Prefs: IPreferences); +procedure TGeneralPrefsFrame.Activate(const Prefs: IPreferences; + const Flags: UInt64); {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } diff --git a/Src/FrHTMLDlg.pas b/Src/FrHTMLDlg.pas index fc1e17039..b9901068a 100644 --- a/Src/FrHTMLDlg.pas +++ b/Src/FrHTMLDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2022, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame containing a web browser control that displays HTML * content that takes on the appearance of a dialogue box. @@ -18,9 +18,16 @@ interface uses // Delphi - OleCtrls, SHDocVw, Classes, Controls, ExtCtrls, Forms, + OleCtrls, + SHDocVw, + Classes, + Controls, + ExtCtrls, + Forms, // Project - FrBrowserBase, UCSSBuilder; + Browser.UUIMgr, + FrBrowserBase, + UCSSBuilder; type @@ -35,8 +42,11 @@ THTMLDlgFrame = class(TBrowserBaseFrame) fOwner: TForm; {Form that owns the frame. Used to set font and colours to display in frame's HTML } + function GetScrollStyle: TWBScrollbarStyle; + procedure SetScrollStyle(const AValue: TWBScrollbarStyle); strict protected procedure BuildCSS(const CSSBuilder: TCSSBuilder); override; + published {Generates CSS classes specific to HTML dialog boxes. This CSS is added to that provided by parent class. @param CSSBuilder [in] Object used to build the CSS code. @@ -50,6 +60,7 @@ THTMLDlgFrame = class(TBrowserBaseFrame) {Calculates height of document displayed in browser. @return Document height in pixels. } + property ScrollStyle: TWBScrollbarStyle read GetScrollStyle write SetScrollStyle default sbsHide; end; @@ -58,9 +69,11 @@ implementation uses // Delphi - SysUtils, Graphics, + SysUtils, + Graphics, // Project - Browser.UUIMgr, UCSSUtils, UNulDropTarget; + UCSSUtils, + UNulDropTarget; {$R *.dfm} @@ -80,38 +93,30 @@ procedure THTMLDlgFrame.BuildCSS(const CSSBuilder: TCSSBuilder); // Set body style to use dialog box colour and font with no margin CSSFont := TFont.Create; try - with CSSBuilder.AddSelector('body') do - begin - AddProperty(TCSS.BackgroundColorProp(fOwner.Color)); - AddProperty(TCSS.FontProps(fOwner.Font)); - AddProperty(TCSS.MarginProp(0)); - end; + CSSBuilder.AddSelector('body') + .AddProperty(TCSS.BackgroundColorProp(fOwner.Color)) + .AddProperty(TCSS.FontProps(fOwner.Font)) + .AddProperty(TCSS.MarginProp(0)); // Sets heading margins, padding and font size - with CSSBuilder.AddSelector('h1') do - begin - CSSFont.Assign(Self.Font); - CSSFont.Size := CSSFont.Size + 2; - CSSFont.Style := [fsBold]; - AddProperty(TCSS.FontProps(CSSFont)); - AddProperty(TCSS.MarginProp(0)); - AddProperty(TCSS.PaddingProp(0)); - end; + CSSFont.Assign(Self.Font); + CSSFont.Size := CSSFont.Size + 2; + CSSFont.Style := [fsBold]; + CSSBuilder.AddSelector('h1') + .AddProperty(TCSS.FontProps(CSSFont)) + .AddProperty(TCSS.MarginProp(0)) + .AddProperty(TCSS.PaddingProp(0)); // Sets paragraph margins and padding - with CSSBuilder.AddSelector('p') do - begin - AddProperty(TCSS.MarginProp(cssTop, 6)); - AddProperty(TCSS.MarginProp(cssBottom, 0)); - AddProperty(TCSS.PaddingProp(0)); - end; - with CSSBuilder.AddSelector('ul') do - begin - AddProperty(TCSS.MarginProp(cssTop, 6)); - AddProperty(TCSS.MarginProp(cssBottom, 0)); - AddProperty(TCSS.PaddingProp(0)); - end; + CSSBuilder.AddSelector('p') + .AddProperty(TCSS.MarginProp(cssTop, 6)) + .AddProperty(TCSS.MarginProp(cssBottom, 0)) + .AddProperty(TCSS.PaddingProp(0)); + CSSBuilder.AddSelector('ul') + .AddProperty(TCSS.MarginProp(cssTop, 6)) + .AddProperty(TCSS.MarginProp(cssBottom, 0)) + .AddProperty(TCSS.PaddingProp(0)); // Sets table font info - with CSSBuilder.AddSelector('table') do - AddProperty(TCSS.FontProps(fOwner.Font)); + CSSBuilder.AddSelector('table') + .AddProperty(TCSS.FontProps(fOwner.Font)); finally FreeAndNil(CSSFont); end; @@ -140,5 +145,16 @@ function THTMLDlgFrame.DocHeight: Integer; Result := WBController.UIMgr.DocHeight; end; +function THTMLDlgFrame.GetScrollStyle: TWBScrollbarStyle; +begin + Result := WBController.UIMgr.ScrollbarStyle; +end; + +procedure THTMLDlgFrame.SetScrollStyle(const AValue: TWBScrollbarStyle); +begin + if AValue <> GetScrollStyle then + WBController.UIMgr.ScrollbarStyle := AValue; +end; + end. diff --git a/Src/FrHTMLPreview.pas b/Src/FrHTMLPreview.pas index bc2aade49..e45cc0641 100644 --- a/Src/FrHTMLPreview.pas +++ b/Src/FrHTMLPreview.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2022, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame used to display previews of HTML documents. } @@ -70,8 +70,8 @@ procedure THTMLPreviewFrame.BuildCSS(const CSSBuilder: TCSSBuilder); } begin inherited; - with CSSBuilder.AddSelector('body') do - AddProperty(TCSS.MarginProp(cPreviewMargin)); + CSSBuilder.AddSelector('body') + .AddProperty(TCSS.MarginProp(cPreviewMargin)); end; procedure THTMLPreviewFrame.Display(const DocContent: TEncodedData); diff --git a/Src/FrHTMLTpltDlg.pas b/Src/FrHTMLTpltDlg.pas index d84b9ab04..af15a0328 100644 --- a/Src/FrHTMLTpltDlg.pas +++ b/Src/FrHTMLTpltDlg.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame containing a web browser control that displays HTML * content generated from a template that takes on the appearance of a dialogue diff --git a/Src/FrHiliterPrefs.pas b/Src/FrHiliterPrefs.pas index 97c1ded47..61f6816f2 100644 --- a/Src/FrHiliterPrefs.pas +++ b/Src/FrHiliterPrefs.pas @@ -1,13 +1,14 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2025, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that allows the user to set syntax highlighter - * preferences. Designed for use as one of the tabs in the Preferences dialogue - * box. + * preferences. + * + * Designed for use as one of the pages in the Preferences dialogue box. } @@ -130,9 +131,7 @@ THiliterPrefsFrame = class(TPrefsBaseFrame) /// <summary>Generates and returns RTF representation of currently selected /// highlighter element.</summary> /// <remarks>This RTF is used to display elememt in preview pane.</remarks> - function GenerateRTF: TRTF; - /// <summary>Returns reference to form that hosts the frame.</summary> - function ParentForm: TForm; + function GenerateRTF: TRTFMarkup; public /// <summary>Constructs frame instance and initialises controls.</summary> /// <param name="AOwner">TComponent [in] Component that owns the frame. @@ -143,7 +142,8 @@ THiliterPrefsFrame = class(TPrefsBaseFrame) /// <summary>Updates controls from given preferences object.</summary> /// <remarks>Called when the dialogue page containing the frame is /// activated.</remarks> - procedure Activate(const Prefs: IPreferences); override; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); + override; /// <summary>Updates given preferences object with data entered in controls. /// </summary> /// <remarks>Called when the dialogue page containing the frame is @@ -178,6 +178,7 @@ implementation // Delphi SysUtils, ExtCtrls, Windows, Graphics, Dialogs, // Project + ClassHelpers.RichEdit, FmPreferencesDlg, FmNewHiliterNameDlg, FmUserHiliterMgrDlg, Hiliter.UAttrs, IntfCommon, UCtrlArranger, UFontHelper, UIStringList, UMessageBox, URTFBuilder, URTFStyles, UUtils; @@ -216,6 +217,8 @@ implementation // Error messages sErrBadFontSize = 'Invalid font size'; + sErrBadFontRange = 'Font size out of range. ' + + 'Enter a value between %0:d and %1:d'; const /// <summary>Map of highlighter elements to descriptions.</summary> @@ -254,7 +257,8 @@ implementation { THiliterPrefsFrame } -procedure THiliterPrefsFrame.Activate(const Prefs: IPreferences); +procedure THiliterPrefsFrame.Activate(const Prefs: IPreferences; + const Flags: UInt64); begin (fAttrs as IAssignable).Assign(Prefs.HiliteAttrs); (fNamedAttrs as IAssignable).Assign(Prefs.NamedHiliteAttrs); @@ -342,10 +346,24 @@ procedure THiliterPrefsFrame.cbFontSizeChange(Sender: TObject); Exit; if TryStrToInt(cbFontSize.Text, Size) then begin - // Combo has valid value entered: update - fAttrs.FontSize := Size; - UpdatePreview; - fChanged := True; + if TFontHelper.IsInCommonFontSizeRange(Size) then + begin + // Combo has valid value entered: update + fAttrs.FontSize := Size; + UpdatePreview; + fChanged := True; + end + else + begin + TMessageBox.Error( + ParentForm, + Format( + sErrBadFontRange, + [TFontHelper.CommonFontSizes.Min, TFontHelper.CommonFontSizes.Max] + ) + ); + cbFontSize.Text := IntToStr(fAttrs.FontSize); + end; end else begin @@ -461,7 +479,7 @@ function THiliterPrefsFrame.DisplayName: string; Result := sDisplayName; end; -function THiliterPrefsFrame.GenerateRTF: TRTF; +function THiliterPrefsFrame.GenerateRTF: TRTFMarkup; var RTFBuilder: TRTFBuilder; // object used to create and render RTFBuilder EgLines: IStringList; // list of lines in the example @@ -521,20 +539,6 @@ procedure THiliterPrefsFrame.miNamedStylesClick(Sender: TObject); UpdatePopupMenu; end; -function THiliterPrefsFrame.ParentForm: TForm; -var - ParentCtrl: TWinControl; // reference to parent controls -begin - // Loop through parent controls until form found or top level parent reached - ParentCtrl := Self.Parent; - while Assigned(ParentCtrl) and not (ParentCtrl is TForm) do - ParentCtrl := ParentCtrl.Parent; - if ParentCtrl is TForm then - Result := ParentCtrl as TForm - else - Result := nil; -end; - procedure THiliterPrefsFrame.PopulateElementsList; var ElemId: THiliteElement; // loops thru all highlighter elements @@ -611,7 +615,7 @@ procedure THiliterPrefsFrame.UpdatePopupMenu; procedure THiliterPrefsFrame.UpdatePreview; begin - TRichEditHelper.Load(frmExample.RichEdit, GenerateRTF); + frmExample.RichEdit.Load(GenerateRTF); end; initialization diff --git a/Src/FrMemoPreview.pas b/Src/FrMemoPreview.pas index 5d2fd9727..6a8864b1d 100644 --- a/Src/FrMemoPreview.pas +++ b/Src/FrMemoPreview.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements an abstract base class for frames used to display previews of * documents using controls that descend from TCustomMemo. @@ -141,13 +141,15 @@ procedure TMemoPreviewFrame.SelectAll; procedure TMemoPreviewFrame.SetMargin; {Sets fixed size margin around control. } +var + MemoHelper: TMemoHelper; begin - with TMemoHelper.Create(GetMemoCtrl) do - try - SetMargin(cPreviewMargin); - finally - Free; - end; + MemoHelper := TMemoHelper.Create(GetMemoCtrl); + try + MemoHelper.SetMargin(cPreviewMargin); + finally + MemoHelper.Free; + end; end; end. diff --git a/Src/FrNewsPrefs.dfm b/Src/FrNewsPrefs.dfm deleted file mode 100644 index d8d334354..000000000 --- a/Src/FrNewsPrefs.dfm +++ /dev/null @@ -1,29 +0,0 @@ -inherited NewsPrefsFrame: TNewsPrefsFrame - object lblAgePrefix: TLabel - Left = 0 - Top = 16 - Width = 116 - Height = 13 - Caption = '&Display news going back' - FocusControl = seAge - end - object lblAgeSuffix: TLabel - Left = 184 - Top = 16 - Width = 121 - Height = 13 - Caption = 'days. (min 14, max 365).' - end - object seAge: TSpinEdit - Left = 128 - Top = 13 - Width = 50 - Height = 22 - MaxValue = 365 - MinValue = 14 - ParentShowHint = False - ShowHint = False - TabOrder = 0 - Value = 14 - end -end diff --git a/Src/FrNewsPrefs.pas b/Src/FrNewsPrefs.pas deleted file mode 100644 index 78a17f573..000000000 --- a/Src/FrNewsPrefs.pas +++ /dev/null @@ -1,149 +0,0 @@ -{ - * This Source Code Form is subject to the terms of the Mozilla Public License, - * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ - * - * Copyright (C) 2011-2020, Peter Johnson (gravatar.com/delphidabbler). - * - * Implements a frame that allows user to set preferences that relate to news - * items. - * Designed for use as one of the tabs in the Preferences dialogue box. -} - - -unit FrNewsPrefs; - - -interface - - -uses - // Delphi - Controls, StdCtrls, Spin, Classes, - // Project - FrPrefsBase, UPreferences; - - -type - { - TNewsPrefsFrame: - Frame that allows user to set preferences that relate to news items. Can - persist preferences entered by user. Note: Designed for use in preferences - dialog box. - } - TNewsPrefsFrame = class(TPrefsBaseFrame) - lblAgePrefix: TLabel; - lblAgeSuffix: TLabel; - seAge: TSpinEdit; - public - constructor Create(AOwner: TComponent); override; - {Object constructor. Sets up frame. - @param AOwner [in] Component that owns frame. - } - procedure Activate(const Prefs: IPreferences); override; - {Called when page activated. Updates controls. - @param Prefs [in] Object that provides info used to update controls. - } - procedure Deactivate(const Prefs: IPreferences); override; - {Called when page is deactivated. Stores information entered by user. - @param Prefs [in] Object used to store information. - } - /// <summary>Checks if preference changes require that main window UI is - /// updated.</summary> - /// <remarks>Called when dialog box containing frame is closing. Always - /// returns False because these preferences never affect UI.</remarks> - function UIUpdated: Boolean; override; - procedure ArrangeControls; override; - {Arranges controls on frame. Called after frame has been sized. - } - function DisplayName: string; override; - {Caption that is displayed in the tab sheet that contains this frame when - displayed in the preference dialog box. - @return Required display name. - } - class function Index: Byte; override; - {Index number that determines the location of the tab containing this - frame when displayed in the preferences dialog box. - @return Required index number. - } - end; - - -implementation - - -uses - // Project - FmPreferencesDlg, UCtrlArranger; - - -{$R *.dfm} - -{ TNewPrefsFrame } - -procedure TNewsPrefsFrame.Activate(const Prefs: IPreferences); - {Called when page activated. Updates controls. - @param Prefs [in] Object that provides info used to update controls. - } -begin - seAge.Value := Prefs.NewsAge; -end; - -procedure TNewsPrefsFrame.ArrangeControls; - {Arranges controls on frame. Called after frame has been sized. - } -begin - lblAgePrefix.Left := 0; - TCtrlArranger.MoveToRightOf(lblAgePrefix, seAge, 6); - TCtrlArranger.MoveToRightOf(seAge, lblAgeSuffix, 6); - TCtrlArranger.AlignVCentres(8, [lblAgePrefix, seAge, lblAgeSuffix]); -end; - -constructor TNewsPrefsFrame.Create(AOwner: TComponent); - {Object constructor. Sets up frame. - @param AOwner [in] Component that owns frame. - } -begin - inherited; - HelpKeyword := 'NewsPrefs'; -end; - -procedure TNewsPrefsFrame.Deactivate(const Prefs: IPreferences); - {Called when page is deactivated. Stores information entered by user. - @param Prefs [in] Object used to store information. - } -begin - Prefs.NewsAge := seAge.Value; -end; - -function TNewsPrefsFrame.DisplayName: string; - {Caption that is displayed in the tab sheet that contains this frame when - displayed in the preference dialog box. - @return Required display name. - } -resourcestring - sDisplayName = 'News'; // display name -begin - Result := sDisplayName; -end; - -class function TNewsPrefsFrame.Index: Byte; - {Index number that determines the location of the tab containing this frame - when displayed in the preferences dialog box. - @return Required index number. - } -begin - Result := 50; -end; - -function TNewsPrefsFrame.UIUpdated: Boolean; -begin - Result := False; -end; - -initialization - -// Register frame with preferences dialog box -TPreferencesDlg.RegisterPage(TNewsPrefsFrame); - -end. diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index 7e2ac962b..17f912f81 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -1,12 +1,15 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * Implements a titled frame that displays lists of snippets, arranged in * different ways, and manages user interaction with the displayed items. + * + * ACKNOWLEDGEMENT: fViewStore view list implemented by @SirRufo (GitHub PR + * #160 & Issue #158). } @@ -18,6 +21,7 @@ interface uses // Delphi + Generics.Collections, ComCtrls, Controls, Classes, Windows, ExtCtrls, StdCtrls, ToolWin, Menus, // Project DB.USnippet, FrTitled, IntfFrameMgrs, IntfNotifier, UCommandBars, @@ -86,7 +90,10 @@ TTVDraw = class(TSnippetsTVDraw) @return True if node is a section header, False if not. } end; + var + fViewStore : TList<IView>; // Stores references to IView instances that + // have weak references in tree nodes fTVDraw: TTVDraw; // Object that renders tree view nodes fNotifier: INotifier; // Notifies app of user initiated events fCanChange: Boolean; // Whether selected node allowed to change @@ -283,6 +290,7 @@ constructor TOverviewFrame.Create(AOwner: TComponent); TabIdx: Integer; // loops through tabs begin inherited; + fViewStore := TList<IView>.Create; // Create delegated (contained) command bar manager for toolbar and popup menu fCommandBars := TCommandBarMgr.Create(Self); fCommandBars.AddCommandBar( @@ -318,6 +326,7 @@ destructor TOverviewFrame.Destroy; fSelectedItem := nil; fSnippetList.Free; // does not free referenced snippets fCommandBars.Free; + fViewStore.Free; inherited; end; @@ -519,7 +528,7 @@ procedure TOverviewFrame.Redisplay; Exit; // Build new treeview using grouping determined by selected tab Builder := BuilderClasses[tcDisplayStyle.TabIndex].Create( - tvSnippets, fSnippetList + tvSnippets, fSnippetList, fViewStore ); Builder.Build; // Restore state of treeview based on last time it was displayed @@ -966,7 +975,12 @@ function TOverviewFrame.TTVDraw.IsSectionHeadNode( ViewItem: IView; // view item represented by node begin ViewItem := (Node as TViewItemTreeNode).ViewItem; - Result := ViewItem.IsGrouping; + // Workaround for possibility that ViewItem might be nil when restarting after + // hibernation. + if Assigned(ViewItem) then + Result := ViewItem.IsGrouping + else + Result := False; end; function TOverviewFrame.TTVDraw.IsUserDefinedNode( @@ -979,7 +993,12 @@ function TOverviewFrame.TTVDraw.IsUserDefinedNode( ViewItem: IView; // view item represented by node begin ViewItem := (Node as TViewItemTreeNode).ViewItem; - Result := ViewItem.IsUserDefined; + // Workaround for possibility that ViewItem might be nil when restarting after + // hibernation. + if Assigned(ViewItem) then + Result := ViewItem.IsUserDefined + else + Result := False; end; end. diff --git a/Src/FrPrefsBase.pas b/Src/FrPrefsBase.pas index ecd20ee04..6ec25b042 100644 --- a/Src/FrPrefsBase.pas +++ b/Src/FrPrefsBase.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that forms an abstract base class for all frames displayed * in the Preferences dialogue box. @@ -38,6 +38,11 @@ TPrefsFrameClass = class of TPrefsBaseFrame; preferences dialog box. } TPrefsBaseFrame = class(TFrame) + strict protected + class function IsFlagSupported(const Flag: UInt64): Boolean; inline; + class function ExtractFrameFlag(const Flag: UInt64): UInt32; inline; + /// <summary>Returns reference to form that hosts the frame.</summary> + function ParentForm: TForm; public procedure SavePrefs(const Prefs: IPreferences); virtual; {Saves information user entered in frame. By default the method simply @@ -45,12 +50,14 @@ TPrefsBaseFrame = class(TFrame) use Prefs object. @param Prefs [in] Object used to store information. } - procedure LoadPrefs(const Prefs: IPreferences); virtual; + procedure LoadPrefs(const Prefs: IPreferences; const Flags: UInt64); + virtual; {Initialises controls. By default the method simply calls Activate. May be overridden to load any custom data that doesn't use Prefs object. @param Prefs [in] Object that provides info used to update controls. } - procedure Activate(const Prefs: IPreferences); virtual; abstract; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); + virtual; abstract; {Called when page activated. Must update controls from preferences. @param Prefs [in] Object that provides info used to update controls. } @@ -77,23 +84,64 @@ TPrefsBaseFrame = class(TFrame) new entries at a later date. @return Required index number. } + class function MakeFrameFlag(const Flag: UInt32): UInt64; inline; end; implementation +uses + // Delphi + SysUtils, + Controls; + {$R *.dfm} { TPrefsBaseFrame } -procedure TPrefsBaseFrame.LoadPrefs(const Prefs: IPreferences); +class function TPrefsBaseFrame.ExtractFrameFlag(const Flag: UInt64): UInt32; +begin + if not IsFlagSupported(Flag) then + Exit(0); + Result := Int64Rec(Flag).Lo; +end; + +class function TPrefsBaseFrame.IsFlagSupported(const Flag: UInt64): Boolean; +begin + Result := Int64Rec(Flag).Hi = UInt32(Index); +end; + +procedure TPrefsBaseFrame.LoadPrefs(const Prefs: IPreferences; + const Flags: UInt64); {Initialises controls. By default the method simply calls Activate. May be overridden to load any custom data that doesn't use Prefs object. @param Prefs [in] Object that provides info used to update controls. } begin - Activate(Prefs); + Activate(Prefs, Flags); +end; + +class function TPrefsBaseFrame.MakeFrameFlag(const Flag: UInt32): UInt64; +begin + // Frame flag is in form $IIIIIIIIFFFFFFFF where $IIIIIIII is the frame's + // index number and $FFFFFFFF is the 32 bit flag or bitmask of flags + Int64Rec(Result).Hi := UInt32(Index); + Int64Rec(Result).Lo := Flag; +end; + +function TPrefsBaseFrame.ParentForm: TForm; +var + ParentCtrl: TWinControl; // reference to parent controls +begin + // Loop through parent controls until form found or top level parent reached + ParentCtrl := Self.Parent; + while Assigned(ParentCtrl) and not (ParentCtrl is TForm) do + ParentCtrl := ParentCtrl.Parent; + if ParentCtrl is TForm then + Result := ParentCtrl as TForm + else + Result := nil; end; procedure TPrefsBaseFrame.SavePrefs(const Prefs: IPreferences); diff --git a/Src/FrPrintingPrefs.dfm b/Src/FrPrintingPrefs.dfm index 90226b3f2..8f82fa663 100644 --- a/Src/FrPrintingPrefs.dfm +++ b/Src/FrPrintingPrefs.dfm @@ -6,6 +6,17 @@ inherited PrintingPrefsFrame: TPrintingPrefsFrame DesignSize = ( 396 311) + object lblInfo: TLabel + Left = 0 + Top = 264 + Width = 329 + Height = 13 + Alignment = taCenter + Anchors = [akLeft, akTop, akRight] + Caption = + 'Your changes will take effect the next time you start the applic' + + 'ation.' + end object gpOutputOptions: TGroupBox Left = 0 Top = 2 @@ -126,17 +137,4 @@ inherited PrintingPrefsFrame: TPrintingPrefsFrame OnKeyPress = NumEditKeyPress end end - object stInfo: TStaticText - Left = 0 - Top = 256 - Width = 393 - Height = 25 - Alignment = taCenter - Anchors = [akLeft, akTop, akRight] - AutoSize = False - Caption = - 'Your changes will take effect the next time you start the applic' + - 'ation.' - TabOrder = 2 - end end diff --git a/Src/FrPrintingPrefs.pas b/Src/FrPrintingPrefs.pas index 86c32fcdc..d5a2b3034 100644 --- a/Src/FrPrintingPrefs.pas +++ b/Src/FrPrintingPrefs.pas @@ -1,12 +1,13 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2025, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a frame that allows user to set printing preferences. Designed for - * use as one of the tabs in the Preferences dialogue box. + * Implements a frame that allows user to set printing preferences. + * + * Designed for use as one of the pages in the Preferences dialogue box. } @@ -44,7 +45,7 @@ TPrintingPrefsFrame = class(TPrefsBaseFrame) edLeft: TEdit; edRight: TEdit; edTop: TEdit; - stInfo: TStaticText; + lblInfo: TLabel; procedure CheckboxClick(Sender: TObject); procedure NumEditKeyPress(Sender: TObject; var Key: Char); strict private @@ -56,11 +57,15 @@ TPrintingPrefsFrame = class(TPrefsBaseFrame) {Displays preview of appearance of document according to current state of controls. } + public + const + HideRestartMessage = 1; public constructor Create(AOwner: TComponent); override; {Class constructor. Sets up frame object. } - procedure Activate(const Prefs: IPreferences); override; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); + override; {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } @@ -96,9 +101,10 @@ implementation // Delphi SysUtils, Windows, Graphics, Math, ComCtrls, // Project - FmPreferencesDlg, Hiliter.UAttrs, Hiliter.UHiliters, IntfCommon, UConsts, - UEncodings, UKeysHelper, UPrintInfo, URTFBuilder, URTFStyles, URTFUtils, - UStrUtils, UUtils; + ClassHelpers.RichEdit, + FmPreferencesDlg, Hiliter.UAttrs, Hiliter.UHiliters, IntfCommon, UColours, + UConsts, UEncodings, UFontHelper, UKeysHelper, UPrintInfo, URTFBuilder, + URTFStyles, UStrUtils, UUtils; {$R *.dfm} @@ -141,7 +147,8 @@ TPrintingPrefsPreview = class(TObject) { TPrintingPrefsFrame } -procedure TPrintingPrefsFrame.Activate(const Prefs: IPreferences); +procedure TPrintingPrefsFrame.Activate(const Prefs: IPreferences; + const Flags: UInt64); {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } @@ -193,13 +200,25 @@ procedure TPrintingPrefsFrame.Activate(const Prefs: IPreferences); // Record current user highlighting choices and display initial preview (fHiliteAttrs as IAssignable).Assign(Prefs.HiliteAttrs); DisplayPreview; + + // Show or hide info label depending on custom flag + if IsFlagSupported(Flags) then + lblInfo.Visible := not ( + ExtractFrameFlag(Flags) and HideRestartMessage = HideRestartMessage + ) + else + lblInfo.Visible := True; end; procedure TPrintingPrefsFrame.ArrangeControls; {Arranges controls on frame. Called after frame has been sized. } begin - // Do nothing: all controls arrange themselves using Anchors property + // No alignment needed: + // all controls use Anchors property to arrange themselves + // Set warning font for info label + TFontHelper.SetDefaultFont(lblInfo.Font); + lblInfo.Font.Color := clWarningText; end; procedure TPrintingPrefsFrame.CheckboxClick(Sender: TObject); @@ -361,7 +380,7 @@ procedure TPrintingPrefsPreview.Generate(const UseColor, SyntaxPrint: Boolean); HiliteSource(UseColor, SyntaxPrint, Builder); Builder.EndPara; // Load document into rich edit - TRichEditHelper.Load(fRe, Builder.Render); + fRe.Load(Builder.Render); finally FreeAndNil(Builder); end; diff --git a/Src/FrProgress.pas b/Src/FrProgress.pas index cf05e7b39..d4ae51ab1 100644 --- a/Src/FrProgress.pas +++ b/Src/FrProgress.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that displays a message and progress bar. Designed for use * with the TUserDataPathDlg dialogue box to indicate progress when moving the diff --git a/Src/FrRTFPreview.pas b/Src/FrRTFPreview.pas index 9b23bff10..294602dab 100644 --- a/Src/FrRTFPreview.pas +++ b/Src/FrRTFPreview.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame used to display previews of RTF documents. } @@ -59,6 +59,7 @@ implementation uses // Project + ClassHelpers.RichEdit, URTFUtils; @@ -80,7 +81,7 @@ procedure TRTFPreviewFrame.LoadContent(const DocContent: TEncodedData); @param DocContent [in] Valid RTF document to be displayed. } begin - TRichEditHelper.Load(reView, TRTF.Create(DocContent)); + reView.Load(TRTFMarkup.Create(DocContent)); end; procedure TRTFPreviewFrame.SetPopupMenu(const Menu: TPopupMenu); diff --git a/Src/FrRTFShowCase.pas b/Src/FrRTFShowCase.pas index d72591d97..1ff93751d 100644 --- a/Src/FrRTFShowCase.pas +++ b/Src/FrRTFShowCase.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame containing a rich edit control that is placed in a "show * case", i.e. behind a transparent control that prevents the RTF control and diff --git a/Src/FrSelectSnippets.pas b/Src/FrSelectSnippets.pas index c3adbcf39..6552d8ead 100644 --- a/Src/FrSelectSnippets.pas +++ b/Src/FrSelectSnippets.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that enables one or more snippets from both the user and * main databases to be selected via a tree view. diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index 4abd97993..4952a2ace 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Provides an abstract base class for frames that enable categorised snippets * to be selected by means of a tree view displaying check boxes. diff --git a/Src/FrSelectUserSnippets.pas b/Src/FrSelectUserSnippets.pas index cc12ee855..28c684c67 100644 --- a/Src/FrSelectUserSnippets.pas +++ b/Src/FrSelectUserSnippets.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that enables one or more snippets in the user-defined * database to be selected via a tree view. diff --git a/Src/FrSnippetLayoutPrefs.pas b/Src/FrSnippetLayoutPrefs.pas index 6d2d2cc9e..a16cc1da4 100644 --- a/Src/FrSnippetLayoutPrefs.pas +++ b/Src/FrSnippetLayoutPrefs.pas @@ -1,13 +1,14 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2012-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2012-2024, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that allows user to customise appearance of different * kinds of snippets in main display. - * Designed for use as one of the tabs in the preferences dialog box. + * + * Designed for use as one of the pages in the Preferences dialogue box. } @@ -64,7 +65,8 @@ TSnippetLayoutPrefsFrame = class(TPrefsBaseFrame) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure Activate(const Prefs: IPreferences); override; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); + override; procedure Deactivate(const Prefs: IPreferences); override; /// <summary>Checks if preference changes require that main window UI is /// updated.</summary> @@ -82,7 +84,9 @@ implementation // Delphi Windows, Graphics, // Project - FmPreferencesDlg, UClassHelpers, UCtrlArranger; + ClassHelpers.UControls, + ClassHelpers.UGraphics, + FmPreferencesDlg, UCtrlArranger; {$R *.dfm} @@ -146,7 +150,8 @@ procedure TSnippetLayoutPrefsFrame.actIncludeFragmentUpdate(Sender: TObject); and (lbAvailableFragments.ItemIndex >= 0); end; -procedure TSnippetLayoutPrefsFrame.Activate(const Prefs: IPreferences); +procedure TSnippetLayoutPrefsFrame.Activate(const Prefs: IPreferences; + const Flags: UInt64); begin fPageStructs.Assign(Prefs.PageStructures); UpdateFragmentInfo; diff --git a/Src/FrSourcePrefs.dfm b/Src/FrSourcePrefs.dfm index f59527039..4900f194a 100644 --- a/Src/FrSourcePrefs.dfm +++ b/Src/FrSourcePrefs.dfm @@ -1,16 +1,16 @@ inherited SourcePrefsFrame: TSourcePrefsFrame Width = 393 - Height = 327 + Height = 323 ExplicitWidth = 393 - ExplicitHeight = 327 + ExplicitHeight = 323 DesignSize = ( 393 - 327) + 323) object gbSourceCode: TGroupBox Left = 0 Top = 0 Width = 393 - Height = 201 + Height = 219 Anchors = [akLeft, akTop, akRight] Caption = ' Source code formatting ' TabOrder = 0 @@ -56,10 +56,18 @@ inherited SourcePrefsFrame: TSourcePrefsFrame Caption = '&Truncate comments to one paragraph' TabOrder = 2 end + object chkUnitImplComments: TCheckBox + Left = 8 + Top = 195 + Width = 345 + Height = 17 + Caption = 'Repeat comments in &unit implemenation section' + TabOrder = 3 + end end object gbFileFormat: TGroupBox Left = 0 - Top = 207 + Top = 229 Width = 393 Height = 81 Anchors = [akLeft, akTop, akRight] diff --git a/Src/FrSourcePrefs.pas b/Src/FrSourcePrefs.pas index 8803863a9..c27caf5fa 100644 --- a/Src/FrSourcePrefs.pas +++ b/Src/FrSourcePrefs.pas @@ -1,12 +1,13 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2025, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame that allows user to set source code preferences. - * Designed for use as one of the tabs in the Preferences dialogue box. + * + * Designed for use as one of the pages in the Preferences dialogue box. } @@ -42,6 +43,7 @@ TSourcePrefsFrame = class(TPrefsBaseFrame) lblCommentStyle: TLabel; lblSnippetFileType: TLabel; chkTruncateComments: TCheckBox; + chkUnitImplComments: TCheckBox; procedure cbCommentStyleChange(Sender: TObject); procedure cbSnippetFileTypeChange(Sender: TObject); strict private @@ -74,7 +76,8 @@ TSourcePrefsFrame = class(TPrefsBaseFrame) constructor Create(AOwner: TComponent); override; {Class constructor. Initialises controls. } - procedure Activate(const Prefs: IPreferences); override; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); + override; {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } @@ -110,6 +113,7 @@ implementation // Delphi SysUtils, Math, // Project + ClassHelpers.RichEdit, FmPreferencesDlg, Hiliter.UAttrs, Hiliter.UFileHiliter, Hiliter.UHiliters, IntfCommon, UConsts, UCtrlArranger, URTFUtils; @@ -119,16 +123,19 @@ implementation resourcestring // File type descriptions - sHTMLFileDesc = 'HTML'; + sHTML5FileDesc = 'HTML 5'; + sXHTMLFileDesc = 'XHTML'; sRTFFileDesc = 'Rich text'; sPascalFileDesc = 'Pascal'; sTextFileDesc = 'Plain text'; + sMarkdownFileDesc = 'Markdown'; const // Maps source code file types to descriptions cFileDescs: array[TSourceFileType] of string = ( - sTextFileDesc, sPascalFileDesc, sHTMLFileDesc, sRTFFileDesc + sTextFileDesc, sPascalFileDesc, sHTML5FileDesc, sXHTMLFileDesc, + sRTFFileDesc, sMarkdownFileDesc ); @@ -156,7 +163,7 @@ TSourcePrefsPreview = class(TObject) @param HiliteAttrs [in] Attributes of highlighter used to render preview. } - function Generate: TRTF; + function Generate: TRTFMarkup; {Generate RTF code used to render preview. @return Required RTF code. } @@ -165,7 +172,8 @@ TSourcePrefsPreview = class(TObject) { TSourcePrefsFrame } -procedure TSourcePrefsFrame.Activate(const Prefs: IPreferences); +procedure TSourcePrefsFrame.Activate(const Prefs: IPreferences; + const Flags: UInt64); {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } @@ -174,6 +182,7 @@ procedure TSourcePrefsFrame.Activate(const Prefs: IPreferences); SelectSourceFileType(Prefs.SourceDefaultFileType); SelectCommentStyle(Prefs.SourceCommentStyle); chkTruncateComments.Checked := Prefs.TruncateSourceComments; + chkUnitImplComments.Checked := Prefs.CommentsInUnitImpl; chkSyntaxHighlighting.Checked := Prefs.SourceSyntaxHilited; (fHiliteAttrs as IAssignable).Assign(Prefs.HiliteAttrs); fHiliteAttrs.ResetDefaultFont; @@ -191,13 +200,15 @@ procedure TSourcePrefsFrame.ArrangeControls; TCtrlArranger.AlignVCentres(20, [lblCommentStyle, cbCommentStyle]); TCtrlArranger.MoveBelow([lblCommentStyle, cbCommentStyle], frmPreview, 8); TCtrlArranger.MoveBelow(frmPreview, chkTruncateComments, 8); - gbSourceCode.ClientHeight := TCtrlArranger.TotalControlHeight(gbSourceCode) - + 10; TCtrlArranger.AlignVCentres(20, [lblSnippetFileType, cbSnippetFileType]); TCtrlArranger.MoveBelow( [lblSnippetFileType, cbSnippetFileType], chkSyntaxHighlighting, 8 ); + TCtrlArranger.MoveBelow(chkTruncateComments, chkUnitImplComments, 8); + + gbSourceCode.ClientHeight := TCtrlArranger.TotalControlHeight(gbSourceCode) + + 10; gbFileFormat.ClientHeight := TCtrlArranger.TotalControlHeight(gbFileFormat) + 10; @@ -211,7 +222,7 @@ procedure TSourcePrefsFrame.ArrangeControls; TCtrlArranger.AlignLefts( [ cbCommentStyle, frmPreview, cbSnippetFileType, chkSyntaxHighlighting, - chkTruncateComments + chkTruncateComments, chkUnitImplComments ], Col2Left ); @@ -264,6 +275,7 @@ procedure TSourcePrefsFrame.Deactivate(const Prefs: IPreferences); begin Prefs.SourceCommentStyle := GetCommentStyle; Prefs.TruncateSourceComments := chkTruncateComments.Checked; + Prefs.CommentsInUnitImpl := chkUnitImplComments.Checked; Prefs.SourceDefaultFileType := GetSourceFileType; Prefs.SourceSyntaxHilited := chkSyntaxHighlighting.Checked; end; @@ -341,6 +353,7 @@ procedure TSourcePrefsFrame.UpdateControlState; chkSyntaxHighlighting.Enabled := TFileHiliter.IsHilitingSupported(GetSourceFileType); chkTruncateComments.Enabled := GetCommentStyle <> csNone; + chkUnitImplComments.Enabled := GetCommentStyle <> csNone; end; procedure TSourcePrefsFrame.UpdatePreview; @@ -354,8 +367,7 @@ procedure TSourcePrefsFrame.UpdatePreview; // Generate and display preview with required comment style Preview := TSourcePrefsPreview.Create(GetCommentStyle, fHiliteAttrs); try - // Display preview - TRichEditHelper.Load(frmPreview.RichEdit, Preview.Generate); + frmPreview.RichEdit.Load(Preview.Generate); finally Preview.Free; end; @@ -396,12 +408,14 @@ constructor TSourcePrefsPreview.Create(const CommentStyle: TCommentStyle; fHiliteAttrs := HiliteAttrs; end; -function TSourcePrefsPreview.Generate: TRTF; +function TSourcePrefsPreview.Generate: TRTFMarkup; {Generate RTF code used to render preview. @return Required RTF code. } begin - Result := TRTF.Create(TRTFDocumentHiliter.Hilite(SourceCode, fHiliteAttrs)); + Result := TRTFMarkup.Create( + TRTFDocumentHiliter.Hilite(SourceCode, fHiliteAttrs) + ); end; function TSourcePrefsPreview.SourceCode: string; diff --git a/Src/FrTextPreview.pas b/Src/FrTextPreview.pas index 4260cf691..a0b91a59a 100644 --- a/Src/FrTextPreview.pas +++ b/Src/FrTextPreview.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a frame used to display previews of plain text documents. } diff --git a/Src/FrTitled.pas b/Src/FrTitled.pas index be9bf13fb..c38712d9a 100644 --- a/Src/FrTitled.pas +++ b/Src/FrTitled.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a base class for frames that display a title bar. } diff --git a/Src/HTML.hrc b/Src/HTML.hrc index 30fd18809..600d279b8 100644 --- a/Src/HTML.hrc +++ b/Src/HTML.hrc @@ -1,8 +1,8 @@ # This Source Code Form is subject to the terms of the Mozilla Public License, # v. 2.0. If a copy of the MPL was not distributed with this file, You can -# obtain one at http://mozilla.org/MPL/2.0/ +# obtain one at https://mozilla.org/MPL/2.0/ # -# Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). +# Copyright (C) 2005-2022, Peter Johnson (gravatar.com/delphidabbler). # # Manifest file used to generate HTML.res resource file. @@ -19,7 +19,7 @@ Res\HTML\dlg-about-database-tplt.html Res\HTML\dlg-easter-egg.html Res\CSS\easteregg.css Res\Scripts\easteregg.js -Res\Scripts\3rdParty\jquery-1.8.0.min.js +Res\Scripts\3rdParty\jquery-1.12.4.min.js Res\Scripts\3rdParty\jquery.cycle.lite.js # compiler error log @@ -28,9 +28,6 @@ Res\HTML\dlg-comperror-tplt.html # active text preview dialogue Res\HTML\dlg-activetext-preview-tplt.html -# news dialogue -Res\HTML\dlg-rssnews.html - # SWAG import dialogue Res\HTML\dlg-swag-import-intro-tplt.html Res\HTML\dlg-swag-import-outro-tplt.html @@ -41,9 +38,13 @@ Res\HTML\dlg-dbupdate-load.html Res\HTML\dlg-dbupdate-finish.html # what's new dialogue -# ------------------- Res\HTML\dlg-whatsnew.html +# delete database dialogue +Res\HTML\dlg-dbdelete.html + +# auto-register new compilers dialogue +Res\HTML\dlg-register-compilers.html # Detail pane pages, scripts and CSS diff --git a/Src/Help/CSS/codesnip.css b/Src/Help/CSS/codesnip.css index bc838fa58..333f831cf 100644 --- a/Src/Help/CSS/codesnip.css +++ b/Src/Help/CSS/codesnip.css @@ -1,9 +1,9 @@ /* * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * CSS for the CodeSnip HTML help file. */ @@ -112,7 +112,7 @@ tr { margin: 0; } -td { +td, th { padding: 4px; margin: 1px; } @@ -122,6 +122,18 @@ table.menu { margin-left: 1em; } +table.bordered { + padding: 0; +} + +table.bordered { + background-color: #ccc; +} + +table.bordered th { + background-color: white; +} + table.menu td.img { width: 24px; height: 24px; @@ -141,10 +153,15 @@ table.menu td.mainitem { background-color: #eee; } -table.menu td.desc { +table.menu td.desc, +table.bordered td { background-color: white; } +table.bordered td.centre { + text-align: center; +} + pre.reml, code.reml { color: purple; diff --git a/Src/Help/CodeSnip.hhp b/Src/Help/CodeSnip.hhp index 3a3d15bfe..c7bb1a367 100644 --- a/Src/Help/CodeSnip.hhp +++ b/Src/Help/CodeSnip.hhp @@ -1,14 +1,14 @@ ; This Source Code Form is subject to the terms of the Mozilla Public License, ; v. 2.0. If a copy of the MPL was not distributed with this file, You can -; obtain one at http://mozilla.org/MPL/2.0/ +; obtain one at https://mozilla.org/MPL/2.0/ ; -; Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). +; Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). ; ; CodeSnip help project file. [OPTIONS] Compatibility=1.1 -Compiled file=..\..\Exe\CodeSnip.chm +Compiled file=..\..\_build\exe\CodeSnip.chm Contents file=TOC.hhc Default topic=HTML\welcome.htm Display compile progress=No @@ -25,6 +25,7 @@ HTML\dlg_addcategory.htm HTML\dlg_backup.htm HTML\dlg_configcompilers.htm HTML\dlg_deletecategory.htm +HTML\dlg_deleteuserdb.htm HTML\dlg_dependencies.htm HTML\dlg_dependencies_edit.htm HTML\dlg_duplicatesnippet.htm @@ -52,9 +53,11 @@ HTML\dlg_prefs_printing.htm HTML\dlg_prefs_snippetlayout.htm HTML\dlg_prefs_sourcecode.htm HTML\dlg_print.htm +HTML\dlg_registercompilers.htm HTML\dlg_renamecategory.htm HTML\dlg_restore.htm HTML\dlg_savehiliter.htm +HTML\dlg_saveinfo.htm HTML\dlg_saveselection.htm HTML\dlg_savesnippet.htm HTML\dlg_selectcompiler.htm @@ -96,9 +99,11 @@ HTML\task_addsnippets.htm HTML\task_backup.htm HTML\task_copysnippet.htm HTML\task_customise.htm +HTML\task_deleteuserdb.htm HTML\task_export.htm HTML\task_generateunit.htm HTML\task_printroutine.htm +HTML\task_registercompilers.htm HTML\task_savesnippet.htm HTML\task_search.htm HTML\task_testcompile.htm diff --git a/Src/Help/HTML/about_compiler_checks.htm b/Src/Help/HTML/about_compiler_checks.htm index b26c94395..d5970d617 100644 --- a/Src/Help/HTML/about_compiler_checks.htm +++ b/Src/Help/HTML/about_compiler_checks.htm @@ -2,9 +2,9 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Help topic explaining compiler checks. --> @@ -34,14 +34,15 @@ <h1> </p> <p> The supported compilers are the Win32 Delphi compilers from Delphi 2 to - Delphi 10.4 Sydney and Free Pascal. + Delphi 13 Florence and Free Pascal. </p> <h2> Configuring CodeSnip </h2> <p> Before <em>CodeSnip</em> can use the compilers it needs to be told about - them. This is done using the <a + them. Compilers are registered for use by <em>CodeSnip</em> This is done + using the <a href="dlg_configcompilers.htm">Configure Compilers</a> dialogue box that is accessed from the <em>Tools</em> menu. </p> @@ -60,7 +61,26 @@ <h2> different compiler switches and search paths. </p> <p> - The portable version of CodeSnip only maintains one set of compiler configuration information per installation. + The portable version of CodeSnip only maintains one set of compiler + configuration information per installation. + </p> + <h3> + Automatic detection of Delphi compilers + </h3> + <p> + By default, when <em>CodeSnip</em> starts up, it will check if there are + any versions of Delphi installed on the user's system that + <em>CodeSnip</em> could use, but that are not registered for use. Any such + compilers are displayed in the <a + href="dlg_registercompilers.htm" + >Unregistered Delphi Installation(s) Detected</a> dialogue box where you + can choose whether or not to register them. + </p> + <p> + It is possible to switch off automatic detection on either a global or a + per compiler basis. For more information see the <a + href="task_registercompilers.htm" + >Register Compilers with <em>CodeSnip</em></a> topic. </p> <h2> Running the tests @@ -96,7 +116,7 @@ <h2> warnings following a test compile, you may be able to inhibit them by configuring <em>CodeSnip</em>'s code generator to emit suitable compiler directives. This is done using the <a href="dlg_prefs_codegen.htm">Code - Generation</a> tab of the <a href="dlg_preferences.htm">Preferences</a> + Generation</a> page of the <a href="dlg_preferences.htm">Preferences</a> dialogue box. Display the dialogue box using the <em>Tools | Preferences</em> menu option. </p> diff --git a/Src/Help/HTML/about_swag.htm b/Src/Help/HTML/about_swag.htm index 05fc14f47..8ce1698fa 100644 --- a/Src/Help/HTML/about_swag.htm +++ b/Src/Help/HTML/about_swag.htm @@ -2,9 +2,9 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2013-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * * Help topic explaining the SWAG database. --> diff --git a/Src/Help/HTML/detail_pane.htm b/Src/Help/HTML/detail_pane.htm index 2858bb88c..cd27e930f 100644 --- a/Src/Help/HTML/detail_pane.htm +++ b/Src/Help/HTML/detail_pane.htm @@ -2,9 +2,9 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Help topic for Details pane. --> @@ -57,7 +57,7 @@ <h2> Newly created snippets and categories may be displayed in new tabs. This happens only if the feature is selected in the <a href="dlg_prefs_display.htm" - >Display</a> tab of the <a + >Display</a> page of the <a href="dlg_preferences.htm" >Preferences</a> dialogue box. </li> @@ -205,7 +205,7 @@ <h3> >snippet kind</a>. The program's default settings for these views can be customised using the <a href="dlg_prefs_snippetlayout.htm" - >Snippet Layout</a> tab of the <a + >Snippet Layout</a> page of the <a href="dlg_preferences.htm" >Preferences</a> dialogue box. </p> diff --git a/Src/Help/HTML/dlg_about.htm b/Src/Help/HTML/dlg_about.htm index 2fa669119..f1eaf8480 100644 --- a/Src/Help/HTML/dlg_about.htm +++ b/Src/Help/HTML/dlg_about.htm @@ -2,9 +2,9 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Help topic for About dialogue box. --> diff --git a/Src/Help/HTML/dlg_addcategory.htm b/Src/Help/HTML/dlg_addcategory.htm index c3a46764a..be63ebacb 100644 --- a/Src/Help/HTML/dlg_addcategory.htm +++ b/Src/Help/HTML/dlg_addcategory.htm @@ -2,9 +2,9 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Help topic for Add Category dialogue box. --> diff --git a/Src/Help/HTML/dlg_backup.htm b/Src/Help/HTML/dlg_backup.htm index c73f8f8d2..0f2d363cb 100644 --- a/Src/Help/HTML/dlg_backup.htm +++ b/Src/Help/HTML/dlg_backup.htm @@ -2,9 +2,9 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2008-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Help topic for Save Backup dialogue box. --> diff --git a/Src/Help/HTML/dlg_configcompilers.htm b/Src/Help/HTML/dlg_configcompilers.htm index e65180a2f..5a5256730 100644 --- a/Src/Help/HTML/dlg_configcompilers.htm +++ b/Src/Help/HTML/dlg_configcompilers.htm @@ -2,9 +2,9 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Help topic for Configure Compilers dialogue box. --> @@ -37,12 +37,12 @@ <h1> Compilers that are installed on the system. It is displayed using the <em>Tools | Configure Compilers</em> menu option. <em>CodeSnip</em> uses these compilers when <a href="about_compiler_checks.htm">test - compiling</a> routines. + compiling</a> snippets. </p> <p class="bordered"> When using the standard version of CodeSnip each logged on user has their - their own compiler configuration, so any changes you make will not affect - other users. The portable edition of CodeSnip only supports one set of + own compiler configuration, so any changes you make will not affect other + users. The portable edition of CodeSnip only supports one set of configuration data per installation. </p> <p> @@ -54,11 +54,14 @@ <h1> <p> Selecting a compiler on the left displays information about it on the right hand side of the dialogue. Here you enter or edit the required - information on three tabs, as follows. + information on four or five tabs, as follows. </p> <h2> Compiler Tab </h2> + <h3> + Compiler file name + </h3> <p> Enter the the full path to the compiler's executable file in the <em>Enter compiler executable file name</em> edit box. This must be file name of @@ -75,8 +78,11 @@ <h2> path to its executable file. The <em>Enter compiler executable file name</em> edit box is cleared. </p> + <h3> + Display compiler results + </h3> <p> - Finally, you can choose whether the compiler is included in the table of + You can choose whether the compiler is included in the table of compile results displayed in the <a href="detail_pane.htm">Details Pane</a>. This is done using the <em>Display results for this compiler in details pane</em> check box. Tick the box to display the compiler's @@ -93,10 +99,35 @@ <h2> doing that will cause a warning message to be displayed in place of the compiler results table. To switch off compiler results completely you should use the <a href="dlg_prefs_snippetlayout.htm">Snippet Layout</a> - tab of the <a href="dlg_preferences.htm">Preferences</a> dialogue box to + page of the <a href="dlg_preferences.htm">Preferences</a> dialogue box to remove the <em>Compiler Results Table</em> component from the different kinds of snippet pages. </p> + <h3> + Automatic compiler detection & registration + </h3> + <p> + By default <em>CodeSnip </em> will automatically detect and register + installed Delphi compilers for use with the program. This can happen in + two ways: + </p> + <ol> + <li> + When the <em>Detect Delphi Compilers</em> button is clicked (see below). + </li> + <li> + Optionally, when the program starts up. + </li> + </ol> + <p> + You can prevent a specific Delphi compiler from being automatically + registered by clearing the <em>Permit auto-detection & registration of + this compiler</em> check box. + </p> + <p class="bordered"> + <strong>Note:</strong> This check box does not appear when the Free Pascal + compiler is selected. + </p> <h2> Switches Tab </h2> @@ -281,15 +312,25 @@ <h2> </h2> <p> <em>CodeSnip</em> can automatically detect the presence of Win 32 Delphi - compilers from Delphi 2 to Delphi 10.4 Sydney. Click the <em>Detect Delphi - Compilers</em> button to do this. Any supported installed version of - Delphi will be recorded. This can save considerable time and avoid - errors. + compilers from Delphi 2 to Delphi 13 Florence. Click the <em>Detect + Delphi Compilers</em> button to do this. Any supported installed version + of Delphi will be recorded<sup>†</sup>. This can save considerable + time and avoid errors. </p> <p> Free Pascal cannot be detected automatically and must be configured manually. </p> + <p> + If the <em>Automatically register newly installed Delphi compilers at + program startup</em> check box is ticked then, when it starts up, + <em>CodeSnip</em> will attempt to register any known Delphi compiler that + is not yet registered with Delphi<sup>†</sup>. + </p> + <p class="bordered"> + † Any version of Delphi for which the <em>Permit auto-detection + & registration of this compiler</em> check box is cleared will not be + recorded. + </p> </body> </html> - diff --git a/Src/Help/HTML/dlg_deletecategory.htm b/Src/Help/HTML/dlg_deletecategory.htm index 021dbf917..0f8833faf 100644 --- a/Src/Help/HTML/dlg_deletecategory.htm +++ b/Src/Help/HTML/dlg_deletecategory.htm @@ -2,9 +2,9 @@ <!-- * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Help topic for Delete Category dialogue box. --> diff --git a/Src/Help/HTML/dlg_deleteuserdb.htm b/Src/Help/HTML/dlg_deleteuserdb.htm new file mode 100644 index 000000000..86cd27a83 --- /dev/null +++ b/Src/Help/HTML/dlg_deleteuserdb.htm @@ -0,0 +1,82 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<!-- + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2022, Peter Johnson (gravatar.com/delphidabbler). + * + * Help topic for Delete User Database dialogue box. +--> +<html> + <head> + <meta + http-equiv="Content-Type" + content="text-html; charset=Windows-1252"> + <title> + Delete User Database Dialogue Box + + + + + + + +

+ Delete User Database Dialogue Box +

+

+ This dialogue box is displayed when you choose the Database | Delete + User Database menu option. +

+

+ Proceed with caution. If you give + permission here, all your user-defined snippets will be + deleted without further confirmation. This action + can't be undone. +

+

+ Click Cancel to back out of this dialogue box. +

+

+ If you decide you really want to do this you must enter the upper case + text DELETE MY SNIPPETS in the edit + box, then press OK. You will get an error message, and the + snippets won't be deleted, if the text you entered is incorrect. +

+

+ Once you enter the required text and click OK all user-defined + snippets will be deleted straight away and the main display will be + re-loaded. +

+

+ You are strongly advised to take a backup of your + snippets before deleting them, in case you change you mind. To do this + first cancel this dialogue box then use the Database | Backup User + Database menu option. +

+

+ Why would you do this? +

+

+ It's very unlikely you will need to delete all your snippets, but there + is one use case where this facility is useful. That is when you are moving + snippets from the standard version of CodeSnip to a portable version, or + vice versa. +

+

+ For further details, see this FAQ. +

+ + \ No newline at end of file diff --git a/Src/Help/HTML/dlg_dependencies.htm b/Src/Help/HTML/dlg_dependencies.htm index d438ef605..a165e0879 100644 --- a/Src/Help/HTML/dlg_dependencies.htm +++ b/Src/Help/HTML/dlg_dependencies.htm @@ -2,9 +2,9 @@ @@ -29,12 +29,18 @@

This dialogue box is displayed by choosing the View | Dependencies menu item or by pressing - Ctrl+D. It has two tabs: - Depends Upon and Required By. + Ctrl+D.

- Depends Upon Tab + Tabs

+

+ The dialogue box has two tabs: Depends Upon and Required + By. +

+

+ Depends Upon Tab +

If the selected snippet has dependencies (i.e. snippets it depends upon in order to compile) a tree of snippets is displayed that shows the direct @@ -47,13 +53,27 @@

error message is displayed. Such a dependency indicates there is an error in the database.

-

+

Required By Tab -

+

This tab displays a simple list of snippets that immediately depend on the selected snippet. Again, if there are no snippets to list, a message is displayed to that effect.

+

+ Select & Close button +

+

+ This button appears to the left of the Close and Help + buttons. It's purpose is to select the snippets listed on the currently + active tab and to display that selection when the dialogue box is closed. + If the active tab lists no snippets then the button is disabled. +

+

+ Warning: Any selection made using this + button will replace any search results that were previously displayed. No + warning will be displayed. +

diff --git a/Src/Help/HTML/dlg_dependencies_edit.htm b/Src/Help/HTML/dlg_dependencies_edit.htm index a765a1a39..763162c42 100644 --- a/Src/Help/HTML/dlg_dependencies_edit.htm +++ b/Src/Help/HTML/dlg_dependencies_edit.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_duplicatesnippet.htm b/Src/Help/HTML/dlg_duplicatesnippet.htm index 63ac5f618..4f42da611 100644 --- a/Src/Help/HTML/dlg_duplicatesnippet.htm +++ b/Src/Help/HTML/dlg_duplicatesnippet.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_editsnippet.htm b/Src/Help/HTML/dlg_editsnippet.htm index e1c79a277..8af0dfad3 100644 --- a/Src/Help/HTML/dlg_editsnippet.htm +++ b/Src/Help/HTML/dlg_editsnippet.htm @@ -2,9 +2,9 @@ @@ -158,7 +158,7 @@

If you prefer to turn off syntax highlighting completely go to the Syntax Highlighter tab of the Syntax Highlighter page of the Preferences dialogue box, click the Use Predefined Styles button and select the No Highliter option. diff --git a/Src/Help/HTML/dlg_elementcolour.htm b/Src/Help/HTML/dlg_elementcolour.htm index 205d18cd4..dbf126d84 100644 --- a/Src/Help/HTML/dlg_elementcolour.htm +++ b/Src/Help/HTML/dlg_elementcolour.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_export.htm b/Src/Help/HTML/dlg_export.htm index e7f86b2d7..b8e1db3ff 100644 --- a/Src/Help/HTML/dlg_export.htm +++ b/Src/Help/HTML/dlg_export.htm @@ -2,9 +2,9 @@ @@ -57,6 +57,10 @@

and the dialogue box remains open. The export can be aborted by clicking the Cancel button.

+

+ Note: Snippet categories and cross references are not + included in the export file. +

diff --git a/Src/Help/HTML/dlg_exportfile.htm b/Src/Help/HTML/dlg_exportfile.htm index 12bb33b1c..de3545c5a 100644 --- a/Src/Help/HTML/dlg_exportfile.htm +++ b/Src/Help/HTML/dlg_exportfile.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_favourites.htm b/Src/Help/HTML/dlg_favourites.htm index 6c3da92d9..2df231576 100644 --- a/Src/Help/HTML/dlg_favourites.htm +++ b/Src/Help/HTML/dlg_favourites.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_findcompiler.htm b/Src/Help/HTML/dlg_findcompiler.htm index f0910fc23..d7aeda2df 100644 --- a/Src/Help/HTML/dlg_findcompiler.htm +++ b/Src/Help/HTML/dlg_findcompiler.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_findtext.htm b/Src/Help/HTML/dlg_findtext.htm index ed48ce94e..fc919b00d 100644 --- a/Src/Help/HTML/dlg_findtext.htm +++ b/Src/Help/HTML/dlg_findtext.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_findxrefs.htm b/Src/Help/HTML/dlg_findxrefs.htm index 350693a33..92304ddc3 100644 --- a/Src/Help/HTML/dlg_findxrefs.htm +++ b/Src/Help/HTML/dlg_findxrefs.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_firstrun.htm b/Src/Help/HTML/dlg_firstrun.htm index eec10a49c..fed435c80 100644 --- a/Src/Help/HTML/dlg_firstrun.htm +++ b/Src/Help/HTML/dlg_firstrun.htm @@ -2,9 +2,9 @@ @@ -85,7 +85,7 @@

You will need to redo any customisation using the Syntax Highlighter tab of the Syntax Highlighter page of the Preferences dialogue box.
@@ -98,7 +98,7 @@

You will need to reconfigure them using the Code Formatting tab of the Code Formatting page of the Preferences dialogue box.
diff --git a/Src/Help/HTML/dlg_hilitemgr.htm b/Src/Help/HTML/dlg_hilitemgr.htm index 569d86bb5..31761ef8d 100644 --- a/Src/Help/HTML/dlg_hilitemgr.htm +++ b/Src/Help/HTML/dlg_hilitemgr.htm @@ -2,9 +2,9 @@ @@ -30,7 +30,7 @@

This dialogue box is displayed from the User Defined Styles option of the drop-down menu displayed by the Use Named Style button located on the Syntax - Highlighter tab of the Preferences + Highlighter page of the Preferences dialogue box.

diff --git a/Src/Help/HTML/dlg_import.htm b/Src/Help/HTML/dlg_import.htm index 6461df660..e9e71a5b1 100644 --- a/Src/Help/HTML/dlg_import.htm +++ b/Src/Help/HTML/dlg_import.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_importfile.htm b/Src/Help/HTML/dlg_importfile.htm index 530638aed..c6fb74b3a 100644 --- a/Src/Help/HTML/dlg_importfile.htm +++ b/Src/Help/HTML/dlg_importfile.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_loadselection.htm b/Src/Help/HTML/dlg_loadselection.htm index 0f64310f8..b8601123e 100644 --- a/Src/Help/HTML/dlg_loadselection.htm +++ b/Src/Help/HTML/dlg_loadselection.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_moveuserdb.htm b/Src/Help/HTML/dlg_moveuserdb.htm index 90ceb0b7f..1ec724995 100644 --- a/Src/Help/HTML/dlg_moveuserdb.htm +++ b/Src/Help/HTML/dlg_moveuserdb.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_pagesetup.htm b/Src/Help/HTML/dlg_pagesetup.htm index 6ed08b9bc..cad0ec963 100644 --- a/Src/Help/HTML/dlg_pagesetup.htm +++ b/Src/Help/HTML/dlg_pagesetup.htm @@ -2,9 +2,9 @@ @@ -74,13 +74,13 @@

The default margin sizes can be specified using the - Printing tab of the + Printing page of the Preferences dialogue box.

The unit of measurement used to set margins is displayed in the group box label. This can be changed on the - Misc. tab of the + Misc. page of the Preferences dialogue box.

diff --git a/Src/Help/HTML/dlg_preferences.htm b/Src/Help/HTML/dlg_preferences.htm index 627c884c3..0f80b146d 100644 --- a/Src/Help/HTML/dlg_preferences.htm +++ b/Src/Help/HTML/dlg_preferences.htm @@ -2,9 +2,9 @@ @@ -31,8 +31,10 @@

dialogue box is accessed via the Tools | Preferences menu option.

- The dialogue box is divided into several sections, accessed by tabs across - the top of the page. These are: + The dialogue box is divided into different "pages". Each page is listed by name in the pane on the left hand side of the dialogue box. Selecting one of these names displays the related page of options on the right. +

+

+ The sections are:

diff --git a/Src/Help/HTML/dlg_prefs_general.htm b/Src/Help/HTML/dlg_prefs_general.htm index 56bb08661..aac2be5da 100644 --- a/Src/Help/HTML/dlg_prefs_general.htm +++ b/Src/Help/HTML/dlg_prefs_general.htm @@ -2,11 +2,11 @@ @@ -24,18 +24,18 @@

- Miscellaneous Preferences + Miscellaneous Preferences Page

- This tab of the Preferences dialogue box is used for miscellaneous preferences that - don't merit a tab of their own. The tab is accessed by selecting the - Tools | Preferences menu item then clicking the Misc. - tab. + don't merit a page of their own. The page is accessed by selecting the + Tools | Preferences menu item then clicking on Misc. in + the list on the left of the window.

- There is only a single option that can be set on this tab. + There is only a single option that can be set on this page.

Measurement diff --git a/Src/Help/HTML/dlg_prefs_hiliter.htm b/Src/Help/HTML/dlg_prefs_hiliter.htm index 683831e9d..aacd45b21 100644 --- a/Src/Help/HTML/dlg_prefs_hiliter.htm +++ b/Src/Help/HTML/dlg_prefs_hiliter.htm @@ -2,11 +2,11 @@ @@ -25,13 +25,14 @@

- Syntax Highlighter Preferences + Syntax Highlighter Preferences Page

The appearance of syntax highlighted source files can be customised using - this tab of the Preferences dialogue - box. The tab is accessed by selecting the Tools | Preferences - menu item then clicking the Syntax Highlighter tab. + this page of the Preferences dialogue + box. The page is accessed by selecting the Tools | Preferences + menu item then clicking on Syntax Highlighter in the list on the + left of the window.

Note @@ -40,7 +41,8 @@

Syntax highlighter customisation applies to the Detail Pane, exported files and source code copied to the clipboard. Highlighting used in printed documents is - configured from the Printing tab. + configured from the Printing + preferences page.

Different syntax highlighter styles can be saved and given identifying @@ -56,7 +58,7 @@

Note: The highlighter font is ignored in code previews in - other tabs of the Preferences dialogue + other pages of the Preferences dialogue box to ensure that previews fit the available space.

diff --git a/Src/Help/HTML/dlg_prefs_printing.htm b/Src/Help/HTML/dlg_prefs_printing.htm index 878869460..ca9f06182 100644 --- a/Src/Help/HTML/dlg_prefs_printing.htm +++ b/Src/Help/HTML/dlg_prefs_printing.htm @@ -2,11 +2,11 @@ @@ -24,22 +24,24 @@

- Printing Preferences + Printing Preferences Page

- This tab of the Preferences dialogue box - is used customise the default appearance of printed output. -

-

- The tab is accessed by selecting the Tools | Preferences menu - item then clicking the Printing tab. You can also display this - tab from the Print dialogue box. + This page of the Preferences dialogue + box is used customise the default appearance of printed output.

- Warning: Options set in this tab usually take effect the - next time the application is started. The exception is when the tab is - displayed from the Print dialogue box, when you can choose to - apply the new options straight away. + The page is accessed by selecting the Tools | Preferences menu + item then clicking on Printing in the list on the left of the + window. You can also display this page from the + Print dialogue box. +

+

+ Warning: When this page is displayed via + the Tools | Preferences menu option options usually only take + effect the next time the application is started. But when the page is + displayed from the Print dialogue box, the changed options take + effect straight away.

Document Formatting Options @@ -64,9 +66,9 @@

When syntax highlighting is enabled the style used is as specified in the - Syntax Highlighter tab. When black and - white printing is specified the highlighter's font styles are used but - colours are ignored. + Syntax Highlighter peferences page. + When black and white printing is specified the highlighter's font styles + are used but colours are ignored.

Page Margins @@ -79,7 +81,8 @@

Margins are displayed and entered either in inches or millimeters. The units being used are displayed in the group box caption. Note: measurement units can be changed on the - Misc. tab, if it is visible. + Misc. preferences page, if it is + visible.

diff --git a/Src/Help/HTML/dlg_prefs_snippetlayout.htm b/Src/Help/HTML/dlg_prefs_snippetlayout.htm index 469853f6b..da48fc1f4 100644 --- a/Src/Help/HTML/dlg_prefs_snippetlayout.htm +++ b/Src/Help/HTML/dlg_prefs_snippetlayout.htm @@ -2,11 +2,11 @@ @@ -24,10 +24,10 @@

- Snippet Layout Preferences + Snippet Layout Preferences Page

- This tab of the Preferences dialogue box is used to customise the layout of pages that display the various >Detail Pane.

- The tab is accessed by selecting the Tools | Preferences menu - item then clicking the Snippet Layout tab in the Preferences dialogue box. + The page is accessed by selecting the Tools | Preferences menu + item then clicking on Snippet Layout in the list on the left of + the window.

Overview diff --git a/Src/Help/HTML/dlg_prefs_sourcecode.htm b/Src/Help/HTML/dlg_prefs_sourcecode.htm index 44b317781..b0ed0fef4 100644 --- a/Src/Help/HTML/dlg_prefs_sourcecode.htm +++ b/Src/Help/HTML/dlg_prefs_sourcecode.htm @@ -2,11 +2,11 @@ @@ -26,14 +26,14 @@

- Code Formatting Preferences + Code Formatting Preferences Page

- This tab of the Preferences dialogue box - is used to configure the format of source code that CodeSnip - writes to file or copies to the clipboard. The tab is accessed by - selecting the Tools | Preferences menu item then clicking the - Code Formatting tab. + This page of the Preferences dialogue + box is used to configure the format of source code that CodeSnip + writes to file or copies to the clipboard. The page is accessed by + selecting the Tools | Preferences menu item then clicking on + Code Formatting in the list on the left of the window.

Source code formatting @@ -69,6 +69,12 @@

comment to use just the first paragraph of the snippet's description by ticking the Truncate comments to one paragraph check box.

+

+ When descriptive comments are enabled, they are included in the interface + section of generated units. You can choose whether or not such comments + are repeated in the unit's implementation section using the Repeat + comments in unit implementation section check box. +

Note: Descriptive comments are not applicable to freeform or @@ -87,7 +93,7 @@

HTML and rich text file types can be syntax highlighted. To enable this option check the Enable syntax highlighting check box. The highlighting can be customised using the - Syntax Highlighter tab. + Syntax Highlighter preferences page.

You can override the default format when saving source code to file by diff --git a/Src/Help/HTML/dlg_print.htm b/Src/Help/HTML/dlg_print.htm index abb5b9ecf..7d398aedf 100644 --- a/Src/Help/HTML/dlg_print.htm +++ b/Src/Help/HTML/dlg_print.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_registercompilers.htm b/Src/Help/HTML/dlg_registercompilers.htm new file mode 100644 index 000000000..3dc52b335 --- /dev/null +++ b/Src/Help/HTML/dlg_registercompilers.htm @@ -0,0 +1,66 @@ + + + + + + + Unregistered Delphi Installation(s) Detected Dialogue Box + + + + + + + +

+ Unregistered Delphi Installation(s) + Detected Dialogue Box +

+

+ This dialogue box is displayed at program start-up if CodeSnip + detects that Delphi compilers are installed on the user's system that have + not yet been registered for use by CodeSnip. +

+

+ The available compilers are listed at the top of the dialogue box. Each + compiler has a check box to its left. You should tick this check box to + permit CodeSnip to register the compiler or leave it clear if you + don't want to register the compiler with CodeSnip. +

+

+ Underneath the list of compilers are some instructions about how to + disable auto-registration of some or all compilers. +

+

+ Once you have made your selection click the OK button to register + the selected compilers with CodeSnip. A message box will pop up + to confirm that the compilers have been registered. +

+

+ Preventing automatic detection +

+

+ You can prevent CodeSnip from checking for any + new compilers on startup in future by ticking the Don't show this + again check box before clicking OK. +

+

+ If you change your mind startup checks can be re-enabled. Alternatively + you can exclude individual Delphi compilers from automatic detection. + For information about how to do this see Register Compilers with CodeSnip. +

+ + diff --git a/Src/Help/HTML/dlg_renamecategory.htm b/Src/Help/HTML/dlg_renamecategory.htm index 87f45f29c..5157e6e8f 100644 --- a/Src/Help/HTML/dlg_renamecategory.htm +++ b/Src/Help/HTML/dlg_renamecategory.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_restore.htm b/Src/Help/HTML/dlg_restore.htm index de14edeed..a1d1f5b41 100644 --- a/Src/Help/HTML/dlg_restore.htm +++ b/Src/Help/HTML/dlg_restore.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_savehiliter.htm b/Src/Help/HTML/dlg_savehiliter.htm index a2836387b..0dd906a30 100644 --- a/Src/Help/HTML/dlg_savehiliter.htm +++ b/Src/Help/HTML/dlg_savehiliter.htm @@ -2,9 +2,9 @@ @@ -28,7 +28,7 @@

This dialogue box is displayed by clicking the Save Style button - in the Syntax Highlighter tab of the + in the Syntax Highlighter page of the Preferences dialogue box.

@@ -44,7 +44,7 @@

You can use a named style by selecting it in the User Defined Highlighters dialogue box, accessed from the Syntax Highlighter - preferences tab's Use Named Style drop-down button. + preferences page's Use Named Style drop-down button.

diff --git a/Src/Help/HTML/dlg_saveinfo.htm b/Src/Help/HTML/dlg_saveinfo.htm new file mode 100644 index 000000000..e35745cdb --- /dev/null +++ b/Src/Help/HTML/dlg_saveinfo.htm @@ -0,0 +1,119 @@ + + + + + + + + + Save Snippet Information Dialogue Box + + + + + + + + +

+ Save Snippet Information Dialogue Box +

+

+ This dialogue box is displayed when the File | Save Snippet + Information menu option is clicked. It is used to specify the file + name, file type and encoding information for the snippet information + that is to be saved. +

+

+ The dialogue is a standard Windows save dialogue box with a few added + options. +

+

+ You specify the name and folder for the file where the snippet information + is to be written in in the usual way. +

+

+ Use the Save as type drop down list to specify the type of file + to be saved. Options are: +

+ +

+ The HTML 5 and XHTML options are very similar and differ only in the + type of HTML that is written. For either type an embedded CSS style + sheet is used to style the document. +

+

+ When any of the HTML 5, XHTML or rich text file types are selected source + code embedded in the snippet information will be syntax highlighted if + the Use syntax highlighting check box is checked. +

+

+ The output file encoding can be be specified in the File Encoding + drop down list. Options vary depending on the file type. Some file types + support only a single encoding. The encodings are: +

+ +

+ The output can be previewed by clicking the Preview button. This + displays the snippet information in a dialogue box, formatted according to your + selections. Text in the preview can be selected and copied to the + clipboard if required. +

+

+ Use the Save button to write the snippet information to disk or choose + Cancel to abort. +

+

+ Warning: When plain text or Markdown formatted + snippet information is written in ANSI format it is possibe that the information + contains characters that can't be represented in the system default ANSI encoding. + If this happens a warning + dialogue box is displayed whenever the snippet information is written to file + or is previewed. +

+

+ Footnote +

+

+ † BOM = Byte Order Mark or Preamble: a sequence of bytes at the + start of a text file that identifies its encoding. +

+ + + \ No newline at end of file diff --git a/Src/Help/HTML/dlg_saveselection.htm b/Src/Help/HTML/dlg_saveselection.htm index f457794d3..8d3ee9153 100644 --- a/Src/Help/HTML/dlg_saveselection.htm +++ b/Src/Help/HTML/dlg_saveselection.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_savesnippet.htm b/Src/Help/HTML/dlg_savesnippet.htm index 9ce3b2600..3e8eba30a 100644 --- a/Src/Help/HTML/dlg_savesnippet.htm +++ b/Src/Help/HTML/dlg_savesnippet.htm @@ -2,9 +2,9 @@ @@ -75,7 +75,13 @@

file except that the extension is .txt rather than .inc.
  • - An HTML file (.html) – This option writes the source code out as a + A HTML 5 file (.html) – This option writes the source code out as a + valid HTML 5 document that uses embedded CSS to format the code. The + source code will be syntax highlighted if the Use syntax + highlighting check box is checked. +
    • +
  • + An XHTML file (.html) – This option writes the source code out as a valid XHTML document that uses embedded CSS to format the code. The source code will be syntax highlighted if the Use syntax highlighting check box is checked. @@ -98,29 +104,34 @@

    The output file encoding can be be specified in the File Encoding drop down list. Options vary depending on the file type. Some file types - support only a single encoding. The encodings are: + support only a single encoding, in which case the drop down list will be + disabled. The encodings are:

    • - ANSI (Default) – the system default ANSI encoding. - Available for both plain text and Pascal include files and as the only - option for rich text files. + ANSI Code Page nnn – ANSI encoding for the system default code page, + where nnn is the code page for the user's locale. + Available for both plain text and Pascal include files.
    • UTF-8 – UTF-8 encoding, with BOM†. Available for both plain text and Pascal include files and as the only - option for XHTML files. If used for Pascal include files be warned that + option for HTML5 and XHTML files. If used for Pascal include files be warned that the files will only compile with compilers that support Unicode source files.
    • - Unicode (Little Endian) – UTF-16 LE encoding, with + UTF-16 Little Endian – UTF-16 LE encoding, with BOM†. Available for plain text files only.
    • - Unicode (Big Endian) – UTF-16 BE encoding, with + UTF-18 Big Endian – UTF-16 BE encoding, with BOM†. Available for plain text files only.
      • +
    • + ASCII – ASCII encoding. Available as the only option for + rich text files. +

    The output can be previewed by clicking the Preview button. This diff --git a/Src/Help/HTML/dlg_saveunit.htm b/Src/Help/HTML/dlg_saveunit.htm index 0e91dfdd0..22c3c7253 100644 --- a/Src/Help/HTML/dlg_saveunit.htm +++ b/Src/Help/HTML/dlg_saveunit.htm @@ -2,9 +2,9 @@ @@ -60,7 +60,13 @@

    file except that the extension is .txt rather than .pas.

  • - An HTML file (.html) – This option writes the source code out as a + A HTML 5 file (.html) – This option writes the source code out as a + valid HTML 5 document that uses embedded CSS to format the code. The + source code will be syntax highlighted if the Use syntax + highlighting check box is checked. +
    • +
  • + An XHTML file (.html) – This option writes the source code out as a valid XHTML document that uses embedded CSS to format the code. The source code will be syntax highlighted if the Use syntax highlighting check box is checked. @@ -83,29 +89,34 @@

    The output file encoding can be be specified in the File Encoding drop down list. Options vary depending on the file type. Some file types - support only a single encoding. The encodings are: + support only a single encoding, in which case the drop down list will be + disabled. The encodings are:

    • - ANSI (Default) – the system default ANSI encoding. - Available for both plain text and Pascal unit files and as the only - option for rich text files. + ANSI Code Page nnn – ANSI encoding for the system default code page, + where nnn is the code page for the user's locale. + Available for both plain text and Pascal unit files.
    • UTF-8 – UTF-8 encoding, with BOM†. Available for both plain text and Pascal unit files and as the only - option for XHTML files. If used for Pascal units be warned that the + option for HTML 5 and XHTML files. If used for Pascal units be warned that the unit will only compile with compilers that support Unicode source files.
    • - Unicode (Little Endian) – UTF-16 LE encoding, with + UTF-16 Little Endian – UTF-16 LE encoding, with BOM†. Available for plain text files only.
    • - Unicode (Big Endian) – UTF-16 BE encoding, with + UTF-18 Big Endian – UTF-16 BE encoding, with BOM†. Available for plain text files only.
      • +
    • + ASCII – ASCII encoding. Available as the only option for + rich text files. +

    The output can be previewed by clicking the Preview button. This diff --git a/Src/Help/HTML/dlg_selectcompiler.htm b/Src/Help/HTML/dlg_selectcompiler.htm index 797645543..0acd280f0 100644 --- a/Src/Help/HTML/dlg_selectcompiler.htm +++ b/Src/Help/HTML/dlg_selectcompiler.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_selectroutines.htm b/Src/Help/HTML/dlg_selectroutines.htm index c9047d65f..c239e5ad3 100644 --- a/Src/Help/HTML/dlg_selectroutines.htm +++ b/Src/Help/HTML/dlg_selectroutines.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_swagimport.htm b/Src/Help/HTML/dlg_swagimport.htm index 890ac1b14..a70ef6f8a 100644 --- a/Src/Help/HTML/dlg_swagimport.htm +++ b/Src/Help/HTML/dlg_swagimport.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_testcompile.htm b/Src/Help/HTML/dlg_testcompile.htm index 33aafc5da..ffa5e947e 100644 --- a/Src/Help/HTML/dlg_testcompile.htm +++ b/Src/Help/HTML/dlg_testcompile.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_trappedbugreport.htm b/Src/Help/HTML/dlg_trappedbugreport.htm index 50bdb520d..e520d49ca 100644 --- a/Src/Help/HTML/dlg_trappedbugreport.htm +++ b/Src/Help/HTML/dlg_trappedbugreport.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/dlg_userbugreport.htm b/Src/Help/HTML/dlg_userbugreport.htm index 17696b92c..3130ed660 100644 --- a/Src/Help/HTML/dlg_userbugreport.htm +++ b/Src/Help/HTML/dlg_userbugreport.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/explain_all_compilers_hidden.htm b/Src/Help/HTML/explain_all_compilers_hidden.htm index 4d4a1a143..efd5bd882 100644 --- a/Src/Help/HTML/explain_all_compilers_hidden.htm +++ b/Src/Help/HTML/explain_all_compilers_hidden.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/license.htm b/Src/Help/HTML/license.htm index 69361bc0a..5f57a6c32 100644 --- a/Src/Help/HTML/license.htm +++ b/Src/Help/HTML/license.htm @@ -2,9 +2,9 @@ @@ -27,7 +27,7 @@

    Summary of End User License Agreement

    - DelphiDabbler CodeSnip is copyright © 2005-2020 by Peter D + DelphiDabbler CodeSnip is copyright © 2005-2025 by Peter D Johnson, diff --git a/Src/Help/HTML/main_menu.htm b/Src/Help/HTML/main_menu.htm index 26d7ada2e..1b0a6fdc0 100644 --- a/Src/Help/HTML/main_menu.htm +++ b/Src/Help/HTML/main_menu.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/markup_editor.htm b/Src/Help/HTML/markup_editor.htm index 9cea536b8..b4154bc18 100644 --- a/Src/Help/HTML/markup_editor.htm +++ b/Src/Help/HTML/markup_editor.htm @@ -2,7 +2,7 @@ diff --git a/Src/Help/HTML/menu_compile.htm b/Src/Help/HTML/menu_compile.htm index b6b321a3a..95b3620af 100644 --- a/Src/Help/HTML/menu_compile.htm +++ b/Src/Help/HTML/menu_compile.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/menu_database.htm b/Src/Help/HTML/menu_database.htm index f38b6bc2f..303a0d8c4 100644 --- a/Src/Help/HTML/menu_database.htm +++ b/Src/Help/HTML/menu_database.htm @@ -2,9 +2,9 @@ @@ -96,6 +96,18 @@

    such as a DropBox or Google Drive sub-directory. + + +   + + + Delete User Database + + + Displays the Delete User Database dialogue box that asks for permission to delete ALL the snippets created by the user. If permission is granted then all snippets user defined snippets will be deleted without any further warning. +
    Use with caution – this action can't be undone. + +

    † The Move User Database option is not available in the diff --git a/Src/Help/HTML/menu_edit.htm b/Src/Help/HTML/menu_edit.htm index 56ac55cc8..09d81d017 100644 --- a/Src/Help/HTML/menu_edit.htm +++ b/Src/Help/HTML/menu_edit.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/menu_file.htm b/Src/Help/HTML/menu_file.htm index b0eb3ce64..a7beabcd4 100644 --- a/Src/Help/HTML/menu_file.htm +++ b/Src/Help/HTML/menu_file.htm @@ -2,9 +2,9 @@ @@ -37,13 +37,29 @@

    to a file. The file contains an annotated fragment of Pascal code. The Save Annotated Source dialogue box is displayed and is used to determine the format of the file being - saved. This can be plain text, a Pascal include file, HTML or RTF. The - latter two options can be syntax highlighted. This option is available + saved. This can be plain text, a Pascal include file, HTML 5, XHTML or RTF. The + latter three options can be syntax highlighted. This option is available only for routine snippets or categories containing routines. Any snippets in a category that are not routines are ignored. + + +   + + + Save Snippet Information
    + [Shift+Ctrl+I] + + + Saves information about the currently selected snippet to file, in + rich text format. The information saved is that displayed in the + Detail Pane. + The Save Snippet Information dialogue + box is displayed where the required file name is entered. + + snippets and saves it to file. The Save Unit dialogue box is displayed and is used to determine the format of the file being saved. The format can be plain text, a Pascal unit - file, HTML or RTF. The latter two options can be syntax highlighted. + file, HTML 5, XHTML or RTF. The latter three options can be syntax highlighted. Freeform snippets are not included in the unit. diff --git a/Src/Help/HTML/menu_help.htm b/Src/Help/HTML/menu_help.htm index f4b548a92..8ecd783f0 100644 --- a/Src/Help/HTML/menu_help.htm +++ b/Src/Help/HTML/menu_help.htm @@ -2,9 +2,9 @@ @@ -97,14 +97,14 @@

    Menu icon - CodeSnip News Blog + CodeSnip News On DelphiDabbler Blog Displays the CodeSnip Blog in the default web browser. The latest news about CodeSnip is posted in the blog. + >DelphiDabbler Blog in the default web browser. The latest news about CodeSnip is posted in this blog. diff --git a/Src/Help/HTML/menu_search.htm b/Src/Help/HTML/menu_search.htm index 461421456..1de316feb 100644 --- a/Src/Help/HTML/menu_search.htm +++ b/Src/Help/HTML/menu_search.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/menu_snippets.htm b/Src/Help/HTML/menu_snippets.htm index 681cef085..9fc121355 100644 --- a/Src/Help/HTML/menu_snippets.htm +++ b/Src/Help/HTML/menu_snippets.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/menu_tools.htm b/Src/Help/HTML/menu_tools.htm index f53689019..698672acd 100644 --- a/Src/Help/HTML/menu_tools.htm +++ b/Src/Help/HTML/menu_tools.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/menu_view.htm b/Src/Help/HTML/menu_view.htm index 7a8ed14f4..ad496b15a 100644 --- a/Src/Help/HTML/menu_view.htm +++ b/Src/Help/HTML/menu_view.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/navigation.htm b/Src/Help/HTML/navigation.htm index 0d21c98ef..cefdd212a 100644 --- a/Src/Help/HTML/navigation.htm +++ b/Src/Help/HTML/navigation.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/new.htm b/Src/Help/HTML/new.htm index 035be814b..336bcd45c 100644 --- a/Src/Help/HTML/new.htm +++ b/Src/Help/HTML/new.htm @@ -2,9 +2,9 @@ @@ -65,7 +65,7 @@

  • There is now finer control over the warnings in generated code via the $WARN directive. This is controlled on the - Code Generation tab of the + Code Generation page of the Preferences dialogue box.
  • @@ -73,7 +73,7 @@

    written to exported snippets and units, in that snippet comments can be restricted to display only the first paragraph of multi-paragraph snippet descriptions. Select this option from the - Code Formatting tab of the + Code Formatting page of the Preferences dialogue box.

  • @@ -81,11 +81,18 @@

    namespaces can be used.

  • - [v4.3] The user defined snippets database can now be + [v4.3/v4.5.1] As of v4.3 the user defined snippets database can now be moved to a user specified directory. This useful for ensuring the database is backed up, for example by placing it in a Dropbox or GoogleDrive sub-folder. (This option is not available in the - portable edition.) + portable edition.) From v4.5.1 the database can also be relocated to a network drive. +
    • +
  • + [v4.7] Snippets can now be imported from the SWAG + (SourceWare Archive Group) collection of snippets. +
    • +
  • + [v4.20] The user defined database can now be deleted.

    • @@ -107,7 +114,7 @@

    The structure of snippet pages in the details pane is now customisable: various page elements can be omitted and the order of elements can be changed. Each snippet type has its own page customisation. Use the - Snippet Layout tab of the + Snippet Layout page of the Preferences dialogue box to do the customisation.

    • @@ -125,7 +132,7 @@

  • The colours used for Snippet and other headings can now be customised - using the Display tab of the + using the Display page of the Preferences dialogue box.
  • @@ -186,6 +193,11 @@

    The Welcome page has been completely redesigned to be cleaner and to provide more useful information about the databases and program.

    • +
  • + [v4.19.0/v4.20.0] From v4.19.0 the font size used in + the overview pane can be customised. The ability to change the font size + in the detail pane was added in v4.20.0. +

    • Favourites [v4.2] @@ -232,6 +244,9 @@

    required namespaces in the Namespaces tab of the Configure Compilers dialogue box. +
  • + [v4.21.0] CodeSnip now detects newly installed Delphi compilers at start up. +

    • Other Features diff --git a/Src/Help/HTML/overview_pane.htm b/Src/Help/HTML/overview_pane.htm index f75e81483..1726affac 100644 --- a/Src/Help/HTML/overview_pane.htm +++ b/Src/Help/HTML/overview_pane.htm @@ -2,9 +2,9 @@ @@ -46,7 +46,7 @@

    Section headers for sections that contain no snippets are hidden by default. This can be changed using the Display tab of the Display page of the Preferences dialogue box.

    @@ -98,7 +98,7 @@

    You can configure whether the overview pane tree view appears fully expanded or fully collapsed on start-up by using the Display tab of the Display page of the Preferences dialogue box.

    diff --git a/Src/Help/HTML/quickstart.htm b/Src/Help/HTML/quickstart.htm index 61a3af786..44ea064b2 100644 --- a/Src/Help/HTML/quickstart.htm +++ b/Src/Help/HTML/quickstart.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/reml.htm b/Src/Help/HTML/reml.htm index c15403f25..0783817a5 100644 --- a/Src/Help/HTML/reml.htm +++ b/Src/Help/HTML/reml.htm @@ -2,9 +2,9 @@ @@ -15,20 +15,6 @@ About REML - About the REML markup language

    - REML is CodeSnip's own little markup language that can - be used to style the text of a snippet's description and / or extra - information. + REML is a little markup language that can be used to style text. It is a SGML language similar to HTML, albeit much smaller. A small number of tags and character entities are supported.

    -

    - Language Details -

    - The REML language is a SGML language similar to a greatly - simplified XHTML. The are a small number of tags you can use. Firstly - there are two block-level tags that render text in paragraphs, while the - other tags format text inline or embed hyplerlinks. + CodeSnip currently supports REML v6. See the REML v6 language definition for full details.

    -

    - Block level tags -

    -
    -
    <p>...</p>
    -
    - Renders the enclosed markup as a simple paragraph. -
    -
    <heading>...</heading>
    -
    - Renders the enclosed markup as a heading. -
    -

    - The following rules apply to the use of - <p> and - <heading> + The following whimsical example demonstrates every supported REML tag along with a couple of character entities: +

    <heading>
+  Wombat converter
+</heading>
+<p>
+ Transforms <strong>wombats</strong> into <em>dongles</em>.
+ <warning><em>W</em>arning:</warning> The <var>Foo</var>
+ variable stores &lt;=<mono>12</mono> accumulated <mono>dongles</mono>.
+</p>
+<p>
+ All 3 species of wombat are supported:
+</p>
+<ol>
+ <li>
+   <p>
+     <a href="https://en.wikipedia.org/wiki/Common_wombat">Common
+     wombat</a>. The following sub-species are supported:
+   </p>
+   <ul>
+     <li>
+       Bass Strait wombat
+     </li>
+     <li>
+       Hirsute wombat
+     </li>
+     <li>
+       Tasmanian wombat
+     </li>
+   </ul>
+ </li>
+ <li>
+   Northen hairy-nosed wombat
+ </li>
+ <li>
+   Southern hairy-nosed wombat
+ </li>
+</ol>
+<p>
+ Copyright &copy; wombaterama, 2024.
+</p>

    -
      -
    1. - The tags must not be nested. -
      2. -
    2. - The tags must be matched, e.g. - <p> must have a matching - </p>. -
      3. -
    3. - All text should be embedded within block level tags, e.g. <heading>heading</heading> <p>text</p> - or simply <p>text</p>. -
      4. -

    - Here are some valid examples: + All this silliness renders something like this:

    -
      -
    1. - <p>Hello World</p> -
      2. -
    2. - <heading>Hello</heading>
      - <p>Hello World</p>       -
      3. -

    - Srictly speaking, the following example is invalid code – the - highlighted sections are in error, because they are not contained within - block tags. -

    - 
    blah<heading>blah</heading>blah<p>blah</p>blah
    -

    - However, CodeSnip is quite permissive and, in many cases, - automatically adds - <p>...</p> - tags for text that is not enclosed in block level tags. The above code is - interpreted as: -

    - 
    <p>blah </p>
-<heading>blah</heading>
-<p>blah </p>
-<p>blah</p>
-<p>blah</p>
    -

    - Inline tags -

    -

    - Here are the available inline tags: -

    -
    -
    <strong>...</strong>
    -
    - Renders the enclosed markup with strong emphasis.
    - Example: <p>Make stuff - <strong>stand out</strong>.</p> -
    -
    <em>...</em>
    -
    - Emphasises the enclosed markup.
    - Example: <p>Draw - <em>attention</em> to something.</p> -
    -
    <var>...</var>
    -
    - Used to indicate the enclosed markup is a variable.
    - Example: <p>Refer to a function - <var>parameter</var>.</p> -
    -
    <warning>...</warning>
    -
    - Used for warning text.
    - Example: - <p><warning>Warning:</warning> - Don't do it!</p> -
    -
    <mono>...</mono>
    -
    - Renders markup in a mono-spaced font.
    - Example: <p>Use the: - <mono>Windows</mono> unit.</p> -
    -
    <a href="url">...</a>
    -
    - Creates a hyperlink. The href attribute must - specify the required URL, which must use one of the http:, - https: or file: protocols; others are not permitted. - If you use the file: protocol it must reference a valid local - or network file. Be aware that if you export a snippet - containing a hyperlink that uses the file: protocol it will - only work on the recipient's system if the specified file exists in the - same location.
    - Example: <p><a - href="http://example.com">Visit - example.com</a></p>.. -
    -
    -

    - Character Entities -

    -

    - The "<" and "&" characters are special within - the markup and must not be used directly, even when you are just entering - plain text. You must use the &lt; character - entity in place of "<" and - &amp; instead of "&". -

    -

    - A few other character entities are supported for convenience. Here is the - complete list: -

    - -

    - By way of an example, if you want to display x < y, use: -

    -

    - x &lt; y -

    -

    - No other symbolic character entities are supported. - However, numeric character entities can be used to insert other characters - by specifying its code. For example &#64; is - equivalent to "@". -

    -

    - Numeric entities should be used with caution. Using a code that is - specific to an ANSI character set may cause unexpected results because - CodeSnip uses Unicode internally and the specified character code - may not represent the same character in ANSI and Unicode. +

    - diff --git a/Src/Help/HTML/snippet_class.htm b/Src/Help/HTML/snippet_class.htm index 6de6567e0..08ef29d2f 100644 --- a/Src/Help/HTML/snippet_class.htm +++ b/Src/Help/HTML/snippet_class.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/snippet_constant.htm b/Src/Help/HTML/snippet_constant.htm index 88ca84307..480f620d7 100644 --- a/Src/Help/HTML/snippet_constant.htm +++ b/Src/Help/HTML/snippet_constant.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/snippet_freeform.htm b/Src/Help/HTML/snippet_freeform.htm index bf7b7b6ba..f5f7f09b5 100644 --- a/Src/Help/HTML/snippet_freeform.htm +++ b/Src/Help/HTML/snippet_freeform.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/snippet_kinds.htm b/Src/Help/HTML/snippet_kinds.htm index 6144ce159..ee1ce5f4c 100644 --- a/Src/Help/HTML/snippet_kinds.htm +++ b/Src/Help/HTML/snippet_kinds.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/snippet_routine.htm b/Src/Help/HTML/snippet_routine.htm index a2658a41e..c0f9ef706 100644 --- a/Src/Help/HTML/snippet_routine.htm +++ b/Src/Help/HTML/snippet_routine.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/snippet_type.htm b/Src/Help/HTML/snippet_type.htm index 0b98d9e04..b6457381b 100644 --- a/Src/Help/HTML/snippet_type.htm +++ b/Src/Help/HTML/snippet_type.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/snippet_unit.htm b/Src/Help/HTML/snippet_unit.htm index 88a5ea43a..1de02d01e 100644 --- a/Src/Help/HTML/snippet_unit.htm +++ b/Src/Help/HTML/snippet_unit.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/task_addsnippets.htm b/Src/Help/HTML/task_addsnippets.htm index 59c243391..deceed9c6 100644 --- a/Src/Help/HTML/task_addsnippets.htm +++ b/Src/Help/HTML/task_addsnippets.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/task_backup.htm b/Src/Help/HTML/task_backup.htm index 9fbc66d42..7772193ac 100644 --- a/Src/Help/HTML/task_backup.htm +++ b/Src/Help/HTML/task_backup.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/task_copysnippet.htm b/Src/Help/HTML/task_copysnippet.htm index ad86e2189..3814c25f4 100644 --- a/Src/Help/HTML/task_copysnippet.htm +++ b/Src/Help/HTML/task_copysnippet.htm @@ -2,9 +2,9 @@ @@ -50,7 +50,7 @@

    A snippets description may be included as a comment, depending on the commenting style specified on the - Code Formatting tab of the + Code Formatting page of the Preferences dialogue box.

    diff --git a/Src/Help/HTML/task_customise.htm b/Src/Help/HTML/task_customise.htm index a300d6eda..bef129e7d 100644 --- a/Src/Help/HTML/task_customise.htm +++ b/Src/Help/HTML/task_customise.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/task_deleteuserdb.htm b/Src/Help/HTML/task_deleteuserdb.htm new file mode 100644 index 000000000..a6264cef9 --- /dev/null +++ b/Src/Help/HTML/task_deleteuserdb.htm @@ -0,0 +1,34 @@ + + + + + + + Delete User Defined Database + + + + +

    + Delete the User-Defined Snippets Database +

    +

    + In the unlikely event you need to delete all of the user defined snippets from CodeSnip you can use the Database | Delete User Database menu option, which will display the Delete User Database dialogue box. +

    +

    + There are very few use cases where you will want to delete the whole database, but one such case is where you want to move your snippets from a portable version of CodeSnip to a standard version, or vice-versa. For more information about this, see this FAQ. +

    + + diff --git a/Src/Help/HTML/task_export.htm b/Src/Help/HTML/task_export.htm index b2c247d01..a8d303fcb 100644 --- a/Src/Help/HTML/task_export.htm +++ b/Src/Help/HTML/task_export.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/task_generateunit.htm b/Src/Help/HTML/task_generateunit.htm index bbd8e23a0..1e043b3b6 100644 --- a/Src/Help/HTML/task_generateunit.htm +++ b/Src/Help/HTML/task_generateunit.htm @@ -2,9 +2,9 @@ @@ -69,7 +69,7 @@

    Whether certain warnings are inihibited in the generated code can be specified using the Code Generation - tab of the Preferences dialogue + page of the Preferences dialogue box. The default commenting style, syntax highlighting and file type can be also be configured using the Code Formatting tab. diff --git a/Src/Help/HTML/task_printroutine.htm b/Src/Help/HTML/task_printroutine.htm index 95c11e746..7ccbe4f91 100644 --- a/Src/Help/HTML/task_printroutine.htm +++ b/Src/Help/HTML/task_printroutine.htm @@ -2,9 +2,9 @@ @@ -49,7 +49,7 @@

    Note that the default output options and margin size can be configured on - the Printing tab of the + the Printing page of the Preferences dialogue box.

    diff --git a/Src/Help/HTML/task_registercompilers.htm b/Src/Help/HTML/task_registercompilers.htm new file mode 100644 index 000000000..21d556623 --- /dev/null +++ b/Src/Help/HTML/task_registercompilers.htm @@ -0,0 +1,120 @@ + + + + + + + Register Compilers + + + + + + + +

    + Register Compilers with + CodeSnip +

    +

    + Before you can test compile a snippet you must first register one or more installed + compilers with CodeSnip. +

    +

    + To do this you must tell CodeSnip how to find the compiler and + configure the required options for it. There are three ways to do this: +

    +
      +
    1. +

      + Manually configure the compiler using the Configure Compilers dialogue box, accessed from the Tools | + Configure Compilers dialogue box. +

      +

      + Note: This is the only option available for Free + Pascal. +

      +
      2. +
    2. +

      + Use the Detect Delphi Compilers button in the Configure Compilers dialogue box. This searches for any installed + Delphi compilers that are not registered and registers them. Any + compilers for which automatic detection has been disabled is ignored + (see below). +

      +
      3. +
    3. +

      + By default CodeSnip checks for any un-registered installed + version of Delphi at start-up, and offers to register them by popping + up the Unregistered Delphi Installation(s) Detected Dialogue Box. +

      +
      4. +
    +

    + Inhibiting Auto-Detection +

    +

    + If you don't want CodeSnip to detect any new, unregistered, + Delphi compilers at startup you can switch the feature off entirely from + the Unregistered Delphi Installation(s) Detected Dialogue Box, by ticking + the Don't show this again check box. You can do the same thing + from the Configure Compilers dialogue box by clearing the Automatically + register newly installed Delphi compilers at startup check box. +

    +

    + Alternatively, if you don't want CodeSnip to automatically detect + one or more specific Delphi compilers you can do that in the Configure Compilers dialogue box. You just need to clear the + Permit auto-detection & registration of this compiler check + box on a selected compiler's Compiler tab. If you do this then + CodeSnip will not suggest registering that compiler at startup. + The Configure Compilers dialogue box's Detect Delphi Compilers + feature will ignore them too. +

    +

    + (Re-)enabling Auto-Detection +

    +

    + Global automatic detection can be enabled from the Configure Compilers dialogue box by ticking the Automatically + register newly installed Delphi compilers at startup check box. +

    +

    + Individually excluded compilers can be included in automatic detection + again by ticking the Permit auto-detection & registration of this + compiler check box on a selected compiler's Compiler tab in + the Configure Compilers dialogue box. +

    + + + diff --git a/Src/Help/HTML/task_savesnippet.htm b/Src/Help/HTML/task_savesnippet.htm index 6008bffa0..dee53867d 100644 --- a/Src/Help/HTML/task_savesnippet.htm +++ b/Src/Help/HTML/task_savesnippet.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/task_search.htm b/Src/Help/HTML/task_search.htm index 5ba55786a..bae9ac523 100644 --- a/Src/Help/HTML/task_search.htm +++ b/Src/Help/HTML/task_search.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/task_testcompile.htm b/Src/Help/HTML/task_testcompile.htm index 4d43f464d..ecac2cf6e 100644 --- a/Src/Help/HTML/task_testcompile.htm +++ b/Src/Help/HTML/task_testcompile.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/task_update.htm b/Src/Help/HTML/task_update.htm index 709672fac..1ac96af4f 100644 --- a/Src/Help/HTML/task_update.htm +++ b/Src/Help/HTML/task_update.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/HTML/tasks.htm b/Src/Help/HTML/tasks.htm index 50150e441..196b56c9c 100644 --- a/Src/Help/HTML/tasks.htm +++ b/Src/Help/HTML/tasks.htm @@ -2,9 +2,9 @@ @@ -42,6 +42,7 @@

  • Print Information about a Snippet +
  • Generate a Pascal Unit
    • @@ -51,6 +52,10 @@

  • Test Compile a Snippet
    • +
  • + Register a Compiler for Test + Compilation +
  • Install or Update the DelphiDabbler Code Snippets Database diff --git a/Src/Help/HTML/welcome.htm b/Src/Help/HTML/welcome.htm index b9fb31a32..524d46074 100644 --- a/Src/Help/HTML/welcome.htm +++ b/Src/Help/HTML/welcome.htm @@ -2,9 +2,9 @@ diff --git a/Src/Help/Images/LICENSE b/Src/Help/Images/LICENSE deleted file mode 100644 index 9e15be494..000000000 --- a/Src/Help/Images/LICENSE +++ /dev/null @@ -1,5 +0,0 @@ -All image files in the Src/Help/Images directory are licensed under the Creative -Commons Attribution Share Alike 3.0 License -(http://creativecommons.org/licenses/by-sa/3.0/). - -A full copy of this license is available in Docs/License.html#CC-BY-SA-3.0. diff --git a/Src/Help/Images/REMLExample.png b/Src/Help/Images/REMLExample.png new file mode 100644 index 000000000..6e7a49f5b Binary files /dev/null and b/Src/Help/Images/REMLExample.png differ diff --git a/Src/Help/Index.hhk b/Src/Help/Index.hhk index 2becf62be..dbc1a4d8c 100644 --- a/Src/Help/Index.hhk +++ b/Src/Help/Index.hhk @@ -2,9 +2,9 @@ @@ -75,6 +75,10 @@

    • +
  • + + +
  • @@ -95,6 +99,10 @@ +
  • + + +
  • @@ -142,6 +150,10 @@ +
  • + + +
  • @@ -304,6 +316,10 @@ +
  • + + +
  • @@ -383,6 +399,9 @@
  • +
  • + + diff --git a/Src/Help/TOC.hhc b/Src/Help/TOC.hhc index 4d5a8ce60..ac2c63139 100644 --- a/Src/Help/TOC.hhc +++ b/Src/Help/TOC.hhc @@ -2,9 +2,9 @@ @@ -132,6 +132,10 @@
    • +
  • + + +
  • @@ -144,6 +148,10 @@ +
  • + + +
  • diff --git a/Src/Hiliter.UAttrs.pas b/Src/Hiliter.UAttrs.pas index 8d7618155..67a970123 100644 --- a/Src/Hiliter.UAttrs.pas +++ b/Src/Hiliter.UAttrs.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). * * Implements classes that define syntax highlighter attributes along with an * object that provides a list of named highlighter attributes. @@ -107,7 +107,11 @@ THiliteAttrs = class(TInterfacedObject, /// Method of IHiliteAttrs. function GetFontSize: Integer; /// Sets size of highlighter font. - /// Method of IHiliteAttrs. + /// + /// If font size is out of range of supported sizes then the + /// highlighter font is reset to its default value. + /// Method of IHiliteAttrs. + /// procedure SetFontSize(const AFontSize: Integer); /// Resets highlighter font name and size to default values. /// @@ -228,6 +232,7 @@ TNamedHiliterAttrs = class(TInterfacedObject, procedure THiliteAttrs.Assign(const Src: IInterface); var Elem: THiliteElement; // loops thru all highlight elements + Attrs: IHiliteAttrs; begin if Assigned(Src) then begin @@ -236,13 +241,11 @@ procedure THiliteAttrs.Assign(const Src: IInterface); ClassName + '.Assign: Src does not support IHiliteAttrs' ); // Src is assigned: copy its properties - with Src as IHiliteAttrs do - begin - Self.SetFontName(FontName); - Self.SetFontSize(FontSize); - for Elem := Low(THiliteElement) to High(THiliteElement) do - (Self.GetElement(Elem) as IAssignable).Assign(Elements[Elem]); - end; + Attrs := Src as IHiliteAttrs; + Self.SetFontName(Attrs.FontName); + Self.SetFontSize(Attrs.FontSize); + for Elem := Low(THiliteElement) to High(THiliteElement) do + (Self.GetElement(Elem) as IAssignable).Assign(Attrs.Elements[Elem]); end else begin @@ -307,12 +310,17 @@ procedure THiliteAttrs.SetFontName(const AFontName: string); procedure THiliteAttrs.SetFontSize(const AFontSize: Integer); begin - fFontSize := AFontSize; + if TFontHelper.IsInCommonFontSizeRange(AFontSize) then + fFontSize := AFontSize + else + fFontSize := cDefFontSize; end; { THiliteElemAttrs } procedure THiliteElemAttrs.Assign(const Src: IInterface); +var + ElemAttrs: IHiliteElemAttrs; begin if Assigned(Src) then begin @@ -321,11 +329,9 @@ procedure THiliteElemAttrs.Assign(const Src: IInterface); ClassName + '.Assign: Src does not support IHiliteElemAttrs' ); // Src is assigned: copy its properties - with Src as IHiliteElemAttrs do - begin - Self.SetForeColor(ForeColor); - Self.SetFontStyle(FontStyle); - end; + ElemAttrs := Src as IHiliteElemAttrs; + Self.SetForeColor(ElemAttrs.ForeColor); + Self.SetFontStyle(ElemAttrs.FontStyle); end else begin diff --git a/Src/Hiliter.UCSS.pas b/Src/Hiliter.UCSS.pas index 55baeb8ad..2a605527e 100644 --- a/Src/Hiliter.UCSS.pas +++ b/Src/Hiliter.UCSS.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2022, Peter Johnson (gravatar.com/delphidabbler). * * Defines a class that generates CSS code to enable syntax highlighted source * to be displayed in HTML. CSS code uses a highlighter's attributes. Access to @@ -82,11 +82,9 @@ procedure THiliterCSS.BuildCSS(const CSSBuilder: TCSSBuilder); Elem: THiliteElement; // loops thru highlighter elements begin // Add font definition in main class - with CSSBuilder.AddSelector('.' + GetMainCSSClassName) do - begin - AddProperty(TCSS.FontFamilyProp(fHiliteAttrs.FontName, cfgMonoSpace)); - AddProperty(TCSS.FontSizeProp(fHiliteAttrs.FontSize)); - end; + CSSBuilder.AddSelector('.' + GetMainCSSClassName) + .AddProperty(TCSS.FontFamilyProp(fHiliteAttrs.FontName, cfgMonoSpace)) + .AddProperty(TCSS.FontSizeProp(fHiliteAttrs.FontSize)); // Add font style and colour definitions for each element for Elem := Low(THiliteElement) to High(THiliteElement) do BuildElemCSS(Elem, CSSBuilder); @@ -105,14 +103,13 @@ procedure THiliterCSS.BuildElemCSS(const Elem: THiliteElement; // We only create CSS class if element attributes are non-nul if not ElemAttr.IsNul then begin - with CSSBuilder.AddSelector('.' + GetElemCSSClassName(Elem)) do - begin - if ElemAttr.ForeColor <> clNone then - AddProperty(TCSS.ColorProp(ElemAttr.ForeColor)); - AddProperty(TCSS.FontWeightProp(ElemAttr.FontStyle)); - AddProperty(TCSS.FontStyleProp(ElemAttr.FontStyle)); - AddProperty(TCSS.TextDecorationProp(ElemAttr.FontStyle)); - end; + CSSBuilder.AddSelector('.' + GetElemCSSClassName(Elem)) + .AddProperty(TCSS.FontWeightProp(ElemAttr.FontStyle)) + .AddProperty(TCSS.FontStyleProp(ElemAttr.FontStyle)) + .AddProperty(TCSS.TextDecorationProp(ElemAttr.FontStyle)) + .AddPropertyIf( + ElemAttr.ForeColor <> clNone, TCSS.ColorProp(ElemAttr.ForeColor) + ); end; end; diff --git a/Src/Hiliter.UFileHiliter.pas b/Src/Hiliter.UFileHiliter.pas index a197540b3..609a4cd74 100644 --- a/Src/Hiliter.UFileHiliter.pas +++ b/Src/Hiliter.UFileHiliter.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2025, Peter Johnson (gravatar.com/delphidabbler). * * Implements a class that generates hilighted and formatted source code for a * specified file type. @@ -99,7 +99,8 @@ function TFileHiliter.Hilite(const SourceCode, DocTitle: string): TEncodedData; begin case fFileType of sfRTF: HilitedDocCls := TRTFDocumentHiliter; - sfHTML: HilitedDocCls := TXHTMLDocumentHiliter; + sfXHTML: HilitedDocCls := TXHTMLDocumentHiliter; + sfHTML5: HilitedDocCls := THTML5DocumentHiliter; else HilitedDocCls := TNulDocumentHiliter; end; if fWantHiliting and IsHilitingSupported(fFileType) then @@ -116,7 +117,7 @@ class function TFileHiliter.IsHilitingSupported( @return True if file type supports highlighting, false if not. } begin - Result := FileType in [sfHTML, sfRTF]; + Result := FileType in [sfHTML5, sfXHTML, sfRTF]; end; end. diff --git a/Src/Hiliter.UGlobals.pas b/Src/Hiliter.UGlobals.pas index 51a1d7492..27623f7ee 100644 --- a/Src/Hiliter.UGlobals.pas +++ b/Src/Hiliter.UGlobals.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Declares various types that describe syntax hilighters and and defines * interfaces to various syntax highlighters and highlighter attributes. diff --git a/Src/Hiliter.UHiliters.pas b/Src/Hiliter.UHiliters.pas index f223ebbe6..45267ca81 100644 --- a/Src/Hiliter.UHiliters.pas +++ b/Src/Hiliter.UHiliters.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * Provides highlighter classes used to format and highlight source code in * various file formats. Contains a factory object and implementation of various @@ -132,7 +132,7 @@ TNulDocumentHiliter = class sealed(TDocumentHiliter) /// /// Creates a highlighted source code document in XHTML format. /// - TXHTMLDocumentHiliter = class sealed(TDocumentHiliter) + THTMLDocumentHiliter = class abstract(TDocumentHiliter) strict private /// Generates the CSS rules to be used in the document. /// IHiliteAttrs [in] Highlighting styles used in @@ -140,6 +140,8 @@ TXHTMLDocumentHiliter = class sealed(TDocumentHiliter) /// string. CSS rules that apply styles specified in Attrs. /// class function GenerateCSSRules(Attrs: IHiliteAttrs): string; + strict protected + class function BuilderClass: THTMLBuilderClass; virtual; abstract; public /// Creates XHTML document containing highlighted source code. /// @@ -154,6 +156,20 @@ TXHTMLDocumentHiliter = class sealed(TDocumentHiliter) override; end; + /// Creates a highlighted source code document in XHTML format. + /// + TXHTMLDocumentHiliter = class sealed(THTMLDocumentHiliter) + strict protected + class function BuilderClass: THTMLBuilderClass; override; + end; + + /// Creates a highlighted source code document in HTML5 format. + /// + THTML5DocumentHiliter = class sealed(THTMLDocumentHiliter) + strict protected + class function BuilderClass: THTMLBuilderClass; override; + end; + type /// /// Creates a highlighted source code document in rich text format. @@ -242,55 +258,56 @@ TRTFHiliteRenderer = class(THiliteRenderer, IHiliteRenderer) end; type - /// - /// Renders highlighted source code in XHTML format. Generated code is - /// recorded in a given HTML code builder object. + /// Renders highlighted source code in any supported HTML format. /// - /// - /// Designed for use with TSyntaxHiliter objects. - /// + /// Designed for use with TSyntaxHiliter objects. THTMLHiliteRenderer = class(THiliteRenderer, IHiliteRenderer) strict private var - /// Object used to record generated XHTML code. + /// Object used to build up the generated HTML. fBuilder: THTMLBuilder; - /// Flag indicating if writing first line of output. + /// Flag indicating if writing the first line of output. + /// fIsFirstLine: Boolean; public - /// Object constructor. Sets up object to render documents. - /// - /// THTMLBuilder [in] Object that receives generated - /// XHTML code. - /// IHiliteAttrs [in] Specifies required highlighting - /// style. If nil document is not highlighted. + /// Object constructor. Sets up the object to render HTML + /// documents. + /// THTMLBuilder [in] Object used to build the + /// required HTML. Builder must be an instance of a concreate + /// descendant class of THTMLBuilder, which is abstract. The type of + /// Builder determines the type of HTML that is generated. + /// IHiliteAttrs [in] Specifies required + /// highlighting style. If nil the document is not highlighted. + /// constructor Create(const Builder: THTMLBuilder; const Attrs: IHiliteAttrs = nil); - /// Initialises XHTML ready to receive highlighted code. - /// Method of IHiliteRenderer. + /// Initialises the HTML ready to receive highlighted code. + /// + /// Method of IHiliteRenderer. procedure Initialise; - /// Tidies up XHTML after all highlighted code processed. + /// Tidies up the HTML after all highlighted code is processed. /// - /// Method of IHiliteRenderer. + /// Method of IHiliteRenderer. procedure Finalise; - /// Emits new line if necessary. - /// Method of IHiliteRenderer. + /// Emits a new line if necessary. + /// Method of IHiliteRenderer. procedure BeginLine; /// Does nothing. /// - /// Handling of new lines is all done by BeginLine. - /// Method of IHiliteRenderer. + /// Handling of new lines is all done by BeginLine. + /// Method of IHiliteRenderer. /// procedure EndLine; - /// Emits any span tag required to style following source code - /// element as specified by Elem. - /// Method of IHiliteRenderer. + /// Emits any <span> tag required to style the following + /// source code element, specified by Elem. + /// Method of IHiliteRenderer. procedure BeforeElem(Elem: THiliteElement); - /// Writes given source code element text. - /// Method of IHiliteRenderer. + /// Writes the given source code element text. + /// Method of IHiliteRenderer. procedure WriteElemText(const Text: string); - /// Closes any span tag used to style source code element - /// specified by Elem. - /// Method of IHiliteRenderer. + /// Closes any <span> tag used to style the source code + /// element specified by Elem. + /// Method of IHiliteRenderer. procedure AfterElem(Elem: THiliteElement); end; @@ -336,14 +353,16 @@ procedure TSyntaxHiliter.ElementHandler(Parser: THilitePasParser; class procedure TSyntaxHiliter.Hilite(const RawCode: string; Renderer: IHiliteRenderer); +var + Instance: TSyntaxHiliter; begin Assert(Assigned(Renderer), ClassName + '.Create: Renderer is nil'); - with InternalCreate(Renderer) do - try - DoHilite(RawCode); - finally - Free; - end; + Instance := InternalCreate(Renderer); + try + Instance.DoHilite(RawCode); + finally + Instance.Free; + end; end; procedure TSyntaxHiliter.LineBeginHandler(Parser: THilitePasParser); @@ -370,9 +389,9 @@ class function TNulDocumentHiliter.Hilite(const RawCode: string; Result := TEncodedData.Create(RawCode, etUnicode); end; -{ TXHTMLDocumentHiliter } +{ THTMLDocumentHiliter } -class function TXHTMLDocumentHiliter.GenerateCSSRules(Attrs: IHiliteAttrs): +class function THTMLDocumentHiliter.GenerateCSSRules(Attrs: IHiliteAttrs): string; var CSSBuilder: TCSSBuilder; // builds CSS code @@ -394,7 +413,7 @@ class function TXHTMLDocumentHiliter.GenerateCSSRules(Attrs: IHiliteAttrs): end; end; -class function TXHTMLDocumentHiliter.Hilite(const RawCode: string; +class function THTMLDocumentHiliter.Hilite(const RawCode: string; Attrs: IHiliteAttrs; const Title: string): TEncodedData; resourcestring // Default document title @@ -403,7 +422,7 @@ class function TXHTMLDocumentHiliter.Hilite(const RawCode: string; Renderer: IHiliteRenderer; // XHTML renderer object Builder: THTMLBuilder; // object used to construct XHTML document begin - Builder := THTMLBuilder.Create; + Builder := BuilderClass.Create; try if Title <> '' then Builder.Title := Title @@ -418,6 +437,20 @@ class function TXHTMLDocumentHiliter.Hilite(const RawCode: string; end; end; +{ TXHTMLDocumentHiliter } + +class function TXHTMLDocumentHiliter.BuilderClass: THTMLBuilderClass; +begin + Result := TXHTMLBuilder; +end; + +{ THTML5DocumentHiliter } + +class function THTML5DocumentHiliter.BuilderClass: THTMLBuilderClass; +begin + Result := THTML5Builder; +end; + { TRTFDocumentHiliter } class function TRTFDocumentHiliter.Hilite(const RawCode: string; diff --git a/Src/Hiliter.UPasLexer.pas b/Src/Hiliter.UPasLexer.pas index 6f11ed348..4a39be357 100644 --- a/Src/Hiliter.UPasLexer.pas +++ b/Src/Hiliter.UPasLexer.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines a class that analyses and tokenises Pascal source code. } diff --git a/Src/Hiliter.UPasParser.pas b/Src/Hiliter.UPasParser.pas index 438923f83..da631da15 100644 --- a/Src/Hiliter.UPasParser.pas +++ b/Src/Hiliter.UPasParser.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines a class that parses Pascal source files and splits into different * highlighting elements. diff --git a/Src/Hiliter.UPersist.pas b/Src/Hiliter.UPersist.pas index 8dfb9902b..d4c271a24 100644 --- a/Src/Hiliter.UPersist.pas +++ b/Src/Hiliter.UPersist.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a static class that can persist syntax highlighter attributes * to/from a given storage. diff --git a/Src/Install/Assets/LICENSE b/Src/Install/Assets/LICENSE deleted file mode 100644 index 7a6a68398..000000000 --- a/Src/Install/Assets/LICENSE +++ /dev/null @@ -1,9 +0,0 @@ -All the files in the Src/Install/Assets directory are governed by the following -license. - -This Source Code Form is subject to the terms of the Mozilla Public -License, v. 2.0. If a copy of the MPL was not distributed with this -file, You can obtain one at http://mozilla.org/MPL/2.0/. - -All files are copyright (C) 2012-2020, Peter Johnson -(gravatar.com/delphidabbler). diff --git a/Src/Install/Assets/License.rtf b/Src/Install/Assets/License.rtf index 28e3ecd94..74ec0e7d1 100644 Binary files a/Src/Install/Assets/License.rtf and b/Src/Install/Assets/License.rtf differ diff --git a/Src/Install/CodeSnip.iss b/Src/Install/CodeSnip.iss index 75c364f7d..229db969a 100644 --- a/Src/Install/CodeSnip.iss +++ b/Src/Install/CodeSnip.iss @@ -1,8 +1,8 @@ ; This Source Code Form is subject to the terms of the Mozilla Public License, ; v. 2.0. If a copy of the MPL was not distributed with this file, You can -; obtain one at http://mozilla.org/MPL/2.0/ +; obtain one at https://mozilla.org/MPL/2.0/ ; -; Copyright (C) 2006-2020, Peter Johnson (gravatar.com/delphidabbler). +; Copyright (C) 2006-2024, Peter Johnson (gravatar.com/delphidabbler). ; ; Install file generation script for use with Inno Setup. @@ -25,10 +25,11 @@ #define ReadMeFile "ReadMe.txt" #define LicenseFile "License.rtf" #define LicenseTextFile "License.html" -#define OutDir SourcePath + "..\..\Exe" +#define OutDir SourcePath + "..\..\_build\exe" #define SrcDocsPath SourcePath + "..\..\Docs\" -#define SrcAssetsPath SourcePath + '\Assets\" -#define SrcExePath SourcePath + "..\..\Exe\" +#define SrcAssetsPath SourcePath + "\Assets\" +#define SrcExePath SourcePath + "..\..\_build\exe\" +#define TmpPath SourcePath + "..\..\_build\release\~tmp~\" #define ProgDataSubDir AppName + ".4" #define ExeProg SrcExePath + ExeFile #define AppVersion DeleteToVerStart(GetFileProductVersion(ExeProg)) @@ -89,7 +90,7 @@ Name: {commonappdata}\{#AppPublisher}\{#ProgDataSubDir}\Database; permissions: e Source: {#SrcExePath}{#ExeFile}; DestDir: {app} Source: {#SrcExePath}{#HelpFile}; DestDir: {app}; Flags: ignoreversion Source: {#SrcDocsPath}{#LicenseTextFile}; DestDir: {app}; Flags: ignoreversion -Source: {#SrcDocsPath}{#ReadMeFile}; DestDir: {app}; Flags: ignoreversion +Source: {#TmpPath}{#ReadMeFile}; DestDir: {app}; Flags: ignoreversion Source: {#SrcAssetsPath}UpdatingPreview.rtf; Flags: dontcopy [Icons] @@ -110,7 +111,7 @@ Type: filesandordirs; Name: "{commonappdata}\{#AppPublisher}\{#ProgDataSubDir}" [Code] // DataLocations.ps must be declared first #include "DataLocations.ps" -#include "VersionInfo.ps" +#include "VersionInfo.ps" #include "Unicode.ps" #include "UpdateIni.ps" #include "UpdateDBase.ps" diff --git a/Src/Install/DataLocations.ps b/Src/Install/DataLocations.ps index 166011550..40ff8d225 100644 Binary files a/Src/Install/DataLocations.ps and b/Src/Install/DataLocations.ps differ diff --git a/Src/Install/EventHandlers.ps b/Src/Install/EventHandlers.ps index 8ca2cbaf5..a4cde1953 100644 Binary files a/Src/Install/EventHandlers.ps and b/Src/Install/EventHandlers.ps differ diff --git a/Src/Install/Unicode.ps b/Src/Install/Unicode.ps index 77c20881a..27ebf16d3 100644 Binary files a/Src/Install/Unicode.ps and b/Src/Install/Unicode.ps differ diff --git a/Src/Install/UpdateDBase.ps b/Src/Install/UpdateDBase.ps index ac0cb98d4..aeaf937a0 100644 Binary files a/Src/Install/UpdateDBase.ps and b/Src/Install/UpdateDBase.ps differ diff --git a/Src/Install/UpdateIni.ps b/Src/Install/UpdateIni.ps index 8faf54e27..3957559d8 100644 Binary files a/Src/Install/UpdateIni.ps and b/Src/Install/UpdateIni.ps differ diff --git a/Src/Install/VersionInfo.ps b/Src/Install/VersionInfo.ps index 29ca1c9cc..cdfc33ab6 100644 Binary files a/Src/Install/VersionInfo.ps and b/Src/Install/VersionInfo.ps differ diff --git a/Src/IntfAligner.pas b/Src/IntfAligner.pas index a60d63226..7bf9e8280 100644 --- a/Src/IntfAligner.pas +++ b/Src/IntfAligner.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2007-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2007-2021, Peter Johnson (gravatar.com/delphidabbler). * * Declares an interface supported by objects that can align a form on screen. } diff --git a/Src/IntfCommon.pas b/Src/IntfCommon.pas index c8c9e2390..976611d1f 100644 --- a/Src/IntfCommon.pas +++ b/Src/IntfCommon.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Common general purpose interfaces. } diff --git a/Src/IntfFrameMgrs.pas b/Src/IntfFrameMgrs.pas index d22b910af..813d320ad 100644 --- a/Src/IntfFrameMgrs.pas +++ b/Src/IntfFrameMgrs.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2025, Peter Johnson (gravatar.com/delphidabbler). * * Declares interfaces, constants and enumerations required to manage various * parts of CodeSnip's UI. diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index a18f3e6af..cb0e460c9 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines interfaces to set up and use the notifier object that triggers * actions in response to user initiated events in the GUI. diff --git a/Src/IntfPreview.pas b/Src/IntfPreview.pas index f404c711d..bf5475836 100644 --- a/Src/IntfPreview.pas +++ b/Src/IntfPreview.pas @@ -1,9 +1,9 @@ { * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Defines the interface implemented by objects that can display a document of a * certain type in a preview dialogue box. diff --git a/Src/LICENSE b/Src/LICENSE deleted file mode 100644 index 2b62ec515..000000000 --- a/Src/LICENSE +++ /dev/null @@ -1,20 +0,0 @@ -This file describes the licenses that apply to source code files in the Src -directory and its sub-directories, unless the sub-directory or its closest -parent directory also contains a LICENSE file, in which case that file takes -precedence. - -Most files contain a comment that provides license information. - -Exceptions are: - -* All .dfm files are licensed under the same license as the related .pas file. - For example, if Foo.pas is licensed under the Mozilla Public License v2.0 then - the same license also applies to Foo.dfm. - -* The following files have any copyright dedicated to the Public Domain - http://creativecommons.org/publicdomain/zero/1.0/ - - - Src/CodeSnip.cfg.tplt - - Src/CodeSnip.dproj - - Src/CodeSnip.groupproj - - Src/CodeSnip.todo \ No newline at end of file diff --git a/Src/Makefile b/Src/Makefile index 39c1dad85..b8b69e3b5 100644 --- a/Src/Makefile +++ b/Src/Makefile @@ -1,16 +1,26 @@ # This Source Code Form is subject to the terms of the Mozilla Public License, # v. 2.0. If a copy of the MPL was not distributed with this file, You can -# obtain one at http://mozilla.org/MPL/2.0/ +# obtain one at https://mozilla.org/MPL/2.0/ # -# Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). +# Copyright (C) 2009-2024, Peter Johnson (gravatar.com/delphidabbler). # # Makefile for the CodeSnip project. -# Define macros giving relative paths to other directories from location of -# makefile -BIN = ..\Bin -EXE = ..\Exe +# Define macros relative paths to various directories relative to the repo root +BUILD_ROOT = _build +BIN_ROOT = $(BUILD_ROOT)\bin +EXE_ROOT = $(BUILD_ROOT)\exe +RELEASE_ROOT = $(BUILD_ROOT)\release +RELEASE_TMP_ROOT = $(RELEASE_ROOT)\~tmp~ +DOCS_ROOT = Docs +SRC_ROOT = Src + +# Defines macros giving directories relative to location of the Makefile +BIN_REL = ..\$(BIN_ROOT) +EXE_REL = ..\$(EXE_ROOT) +DOCS_REL = ..\$(DOCS_ROOT) +RELEASE_TMP_REL = ..\$(RELEASE_TMP_ROOT) # Check for required environment variables @@ -75,11 +85,10 @@ DELPHIDEFINES = # Implicit rules -# Resource files are compiled to the directory specified by BIN macro, which -# must have been set by the caller. +# Resource files are compiled to the directory specified by BIN_REL macro. .rc.res: @echo +++ Compiling Resource file $< +++ - @$(BRCC32) $< -fo$(BIN)\$(@F) + @$(BRCC32) $< -fo$(BIN_REL)\$(@F) # Version info files are compiled by VIEd. A temporary .rc file is left behind .vi.rc: @@ -104,11 +113,13 @@ config: @copy /Y CodeSnip.cfg.tplt CodeSnip.cfg # Create build folders @cd .. - @if exist Bin rmdir /S /Q Bin - @mkdir Bin - @if not exist Exe mkdir Exe - @if not exist Release mkdir Release - @cd Src + @if not exist $(BUILD_ROOT) mkdir $(BUILD_ROOT) + @if exist $(BIN_ROOT) rmdir /S /Q $(BIN_ROOT) + @mkdir $(BIN_ROOT) + @if not exist $(EXE_ROOT) mkdir $(EXE_ROOT) + @if not exist $(RELEASE_ROOT) mkdir $(RELEASE_ROOT) + @if not exist $(RELEASE_TMP_ROOT) mkdir $(RELEASE_TMP_ROOT) + @cd $(SRC_ROOT) # Builds CodeSnip pascal files and links program pascal: CodeSnip.exe @@ -118,14 +129,14 @@ pascal: CodeSnip.exe CodeSnip.exe: @echo +++ Compiling Pascal +++ !ifdef PORTABLE - @if exist $(EXE)\$(@F) copy $(EXE)\$(@F) $(EXE)\$(@F).bak + @if exist $(EXE_REL)\$(@F) copy $(EXE_REL)\$(@F) $(EXE_REL)\$(@F).bak !endif @$(DCC32) $(@B).dpr -B $(DELPHIDEFINES) !ifdef PORTABLE - @copy $(EXE)\$(@F) $(EXE)\$(@B)-p.exe /Y - @del $(EXE)\$(@F) - @if exist $(EXE)\$(@F).bak copy $(EXE)\$(@F).bak $(EXE)\$(@F) - @if exist $(EXE)\$(@F).bak del $(EXE)\$(@F).bak + @copy $(EXE_REL)\$(@F) $(EXE_REL)\$(@B)-p.exe /Y + @del $(EXE_REL)\$(@F) + @if exist $(EXE_REL)\$(@F).bak copy $(EXE_REL)\$(@F).bak $(EXE_REL)\$(@F) + @if exist $(EXE_REL)\$(@F).bak del $(EXE_REL)\$(@F).bak !endif # Builds help file @@ -144,34 +155,45 @@ resources: $(VERINFOFILEBASE).res Resources.res HTML.res # Compiles HTMLres from .hrc file HTML.res: HTML.hrc @echo +++ Compiling HTML Resource manifest file +++ - @$(HTMLRES) -mHTML.hrc -o$(BIN)\HTML.res -r -q + @$(HTMLRES) -mHTML.hrc -o$(BIN_REL)\HTML.res -r -q # Compiles type library from IDL typelib: - @$(GENTLB) .\ExternalObj.ridl -D$(BIN) -TExternalObj.tlb + @$(GENTLB) .\ExternalObj.ridl -D$(BIN_REL) -TExternalObj.tlb # Builds setup program setup: !ifndef PORTABLE - @del ..\Exe\CodeSnip-Setup-* + copy $(DOCS_REL)\ReadMe-standard.txt $(RELEASE_TMP_REL)\ReadMe.txt + del $(EXE_REL)\CodeSnip-Setup-* @$(ISCC) Install\CodeSnip.iss + del $(RELEASE_TMP_REL)\ReadMe.txt !else @echo **** Portable build - no setup file created **** !endif # Creates auto generated files autogen: - @$(TLIBIMP) -P+ -Ps+ -D.\AutoGen -FtIntfExternalObj $(BIN)\ExternalObj.tlb + @$(TLIBIMP) -P+ -Ps+ -D.\AutoGen -FtIntfExternalObj $(BIN_REL)\ExternalObj.tlb @if exist .\AutoGen\IntfExternalObj.dcr del .\AutoGen\IntfExternalObj.dcr # Build release files (.zip) +# If RELEASEFILENAME is defined by caller then it is used as name of zip file +# otherwise default zip file name is used, which depends on whether PORTABLE +# is defined. +# If VERSION is defined by caller then it is appended to RELEASEFILENAME, +# separated by a dash. !ifndef RELEASEFILENAME -RELEASEFILENAME = dd-codesnip -!ifdef PORTABLE -RELEASEFILENAME = $(RELEASEFILENAME)-portable +!ifndef PORTABLE +RELEASEFILENAME = codesnip-exe +!else +RELEASEFILENAME = codesnip-portable-exe +!endif !endif +!ifdef VERSION +RELEASEFILENAME = $(RELEASEFILENAME)-$(VERSION) !endif -OUTFILE = Release\$(RELEASEFILENAME).zip +OUTFILE = $(RELEASE_ROOT)\$(RELEASEFILENAME).zip release: @echo --------------------- @echo Creating Release File @@ -179,14 +201,18 @@ release: @cd .. -@if exist $(OUTFILE) del $(OUTFILE) !ifndef PORTABLE - @$(ZIP) -j -9 $(OUTFILE) Exe\CodeSnip-Setup-*.exe Docs\ReadMe.txt + copy $(DOCS_ROOT)\ReadMe-standard.txt $(RELEASE_TMP_ROOT)\ReadMe.txt + @$(ZIP) -j -9 $(OUTFILE) $(EXE_ROOT)\CodeSnip-Setup-*.exe $(RELEASE_TMP_ROOT)\ReadMe.txt + del $(RELEASE_TMP_ROOT)\ReadMe.txt !else - @$(ZIP) -j -9 $(OUTFILE) Exe\CodeSnip-p.exe - @$(ZIP) -j -9 $(OUTFILE) Exe\CodeSnip.chm - @$(ZIP) -j -9 $(OUTFILE) Docs\ReadMe.txt - @$(ZIP) -j -9 $(OUTFILE) Docs\License.html + copy $(DOCS_ROOT)\ReadMe-portable.txt $(RELEASE_TMP_ROOT)\ReadMe.txt + @$(ZIP) -j -9 $(OUTFILE) $(EXE_ROOT)\CodeSnip-p.exe + @$(ZIP) -j -9 $(OUTFILE) $(EXE_ROOT)\CodeSnip.chm + @$(ZIP) -j -9 $(OUTFILE) $(RELEASE_TMP_ROOT)\ReadMe.txt + @$(ZIP) -j -9 $(OUTFILE) $(DOCS_ROOT)\License.html + del $(RELEASE_TMP_ROOT)\ReadMe.txt !endif - @cd Src + @cd $(SRC_ROOT) # Clean up unwanted files clean: @@ -200,4 +226,4 @@ clean: -@del /S *.tvsconfig 2>nul # remove __history folders -@for /F "usebackq" %i in (`dir /S /B /A:D ..\__history`) do @rmdir /S /Q %i - @cd Src + @cd $(SRC_ROOT) diff --git a/Src/Res/CSS/detail.css b/Src/Res/CSS/detail.css index 725200e82..bea2dc732 100644 --- a/Src/Res/CSS/detail.css +++ b/Src/Res/CSS/detail.css @@ -1,9 +1,9 @@ /* * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * * Cascading style sheet used by HTML displayed in detail panes. */ @@ -57,6 +57,41 @@ p { margin: 4px 0 0 0; } +ul, ol { + margin: 4px 0 0 0; + padding: 0; + list-style-position: outside; +} + +ul { + list-style-type: disc; + padding-left: 24px; +} + +ol { + list-style-type: decimal; + padding-left: 32px; +} + +li ol, +li ul { + margin-top: 0; +} + +li { + padding: 0; + margin: 0; +} + +ul li { + padding-left: 8px; +} + +ul li ol li { + padding-left: 0px; +} + + pre { margin: 4px 0; padding: 4px; diff --git a/Src/Res/CSS/easteregg.css b/Src/Res/CSS/easteregg.css index 1de8ad2be..0a150ee98 100644 --- a/Src/Res/CSS/easteregg.css +++ b/Src/Res/CSS/easteregg.css @@ -1,9 +1,9 @@ /* * This Source Code Form is subject to the terms of the Mozilla Public License, * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at http://mozilla.org/MPL/2.0/ + * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2009-2020, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * * Cascading style sheet used to format HTML displayed in program's easter egg. */ diff --git a/Src/Res/HTML/dlg-about-database-tplt.html b/Src/Res/HTML/dlg-about-database-tplt.html index e2b1e385a..ccc4f9797 100644 --- a/Src/Res/HTML/dlg-about-database-tplt.html +++ b/Src/Res/HTML/dlg-about-database-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-about-database-tplt.html diff --git a/Src/Res/HTML/dlg-about-head-tplt.html b/Src/Res/HTML/dlg-about-head-tplt.html index 2043cc328..90c0e127d 100644 --- a/Src/Res/HTML/dlg-about-head-tplt.html +++ b/Src/Res/HTML/dlg-about-head-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-about-head-tplt diff --git a/Src/Res/HTML/dlg-about-program-tplt.html b/Src/Res/HTML/dlg-about-program-tplt.html index c26bc3091..a337e8b80 100644 --- a/Src/Res/HTML/dlg-about-program-tplt.html +++ b/Src/Res/HTML/dlg-about-program-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-about-program-tplt @@ -47,7 +47,7 @@

    - DelphiDabbler CodeSnip is copyright © 2005-2020 by CodeSnip is copyright © 2005-2025 by Peter D Johnson. @@ -71,39 +71,33 @@ The MD5 digest code used in this program is based on the RSA Data Security, Inc. MD5 Message-Digest Algorithm. -

  • - This software is based, in part, on the work of Anders Melander. -
  • The TListViewEx component used in this program is copyright © 1999-2009 Vadim Crits.
  • - CodeSnip makes use of images from the following icon + CodeSnip makes use of images from the following image collections:
    • - Silk Icon Set 1.3 by Mark James. + Silk Icon Set 1.3 by Mark + James.
    • - Silk Companion 1 by Damien Guard. + Silk Companion 1 by Damien + Guard.
    • - Led Icon Set v1.0. + Led Icon Set v1.0.
    • - 16x16-free-application-icons by Aha-Soft. + 16×16 Free Application + Icons by Aha-Soft.
    • - PixelBox icon collection. + PixelBox icon collection.
    • Public domain images obtained from Clker.com.
      • @@ -126,7 +120,7 @@
    • CodeSnip's installer was created using Inno Setup.
      • diff --git a/Src/Res/HTML/dlg-activetext-preview-tplt.html b/Src/Res/HTML/dlg-activetext-preview-tplt.html index 9620a1d40..a312cd2a1 100644 --- a/Src/Res/HTML/dlg-activetext-preview-tplt.html +++ b/Src/Res/HTML/dlg-activetext-preview-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-activetext-preview-tplt.html diff --git a/Src/Res/HTML/dlg-comperror-tplt.html b/Src/Res/HTML/dlg-comperror-tplt.html index 8a78f5938..46980958a 100644 --- a/Src/Res/HTML/dlg-comperror-tplt.html +++ b/Src/Res/HTML/dlg-comperror-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-comperror-tplt diff --git a/Src/Res/HTML/dlg-dbdelete.html b/Src/Res/HTML/dlg-dbdelete.html new file mode 100644 index 000000000..b21cfb4c7 --- /dev/null +++ b/Src/Res/HTML/dlg-dbdelete.html @@ -0,0 +1,48 @@ + + + + + + + + + + dlg-dbdelete.html + + + + +

      + ARE YOU SURE? +

      + +

      + Before going any further you are strongly advised to take a backup of your snippets database. Use the Database | Backup User Database menu option to do this. +

      + +

      + This action cannot be undone: you will loose all your user-defined snippets. +

      + +

      + To confirm enter DELETE MY SNIPPETS (in capital letters) in the box below, then click OK. +

      + +

      + There will be no further chances to change your mind. +

      + + + + diff --git a/Src/Res/HTML/dlg-dbupdate-finish.html b/Src/Res/HTML/dlg-dbupdate-finish.html index a63e26995..14795acd8 100644 --- a/Src/Res/HTML/dlg-dbupdate-finish.html +++ b/Src/Res/HTML/dlg-dbupdate-finish.html @@ -2,20 +2,20 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-dbupdate-finish.html diff --git a/Src/Res/HTML/dlg-dbupdate-intro-tplt.html b/Src/Res/HTML/dlg-dbupdate-intro-tplt.html index 7ec6e252a..e20e9c423 100644 --- a/Src/Res/HTML/dlg-dbupdate-intro-tplt.html +++ b/Src/Res/HTML/dlg-dbupdate-intro-tplt.html @@ -2,20 +2,20 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-dbupdate-intro-tplt.html diff --git a/Src/Res/HTML/dlg-dbupdate-load.html b/Src/Res/HTML/dlg-dbupdate-load.html index d15334ad0..fd59050c7 100644 --- a/Src/Res/HTML/dlg-dbupdate-load.html +++ b/Src/Res/HTML/dlg-dbupdate-load.html @@ -2,20 +2,20 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-dbupdate-load.html diff --git a/Src/Res/HTML/dlg-easter-egg.html b/Src/Res/HTML/dlg-easter-egg.html index d3779c062..ad02ea31c 100644 --- a/Src/Res/HTML/dlg-easter-egg.html +++ b/Src/Res/HTML/dlg-easter-egg.html @@ -2,20 +2,20 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + @@ -24,7 +24,7 @@ <link rel="stylesheet" href="easteregg.css" /> - <script type="text/javascript" src="jquery-1.8.0.min.js"></script> + <script type="text/javascript" src="jquery-1.12.4.min.js"></script> <script type="text/javascript" src="jquery.cycle.lite.js"></script> <script type="text/javascript" src="easteregg.js"></script> @@ -92,13 +92,13 @@ <h1> <div id="slide-5"> <a class="external-link" - href="http://www.flickr.com/photos/delphidabbler/sets/72157631306758128/" + href="https://www.flickr.com/photos/delphidabbler/sets/72157631306758128/" ><img src="dogs-4.jpg" /></a> <div class="caption"> More pics on <a class="external-link" - href="http://www.flickr.com/photos/delphidabbler/sets/72157631306758128/" + href="https://www.flickr.com/photos/delphidabbler/sets/72157631306758128/" >Flickr</a>... </div> </div> diff --git a/Src/Res/HTML/dlg-register-compilers.html b/Src/Res/HTML/dlg-register-compilers.html new file mode 100644 index 000000000..773bf8734 --- /dev/null +++ b/Src/Res/HTML/dlg-register-compilers.html @@ -0,0 +1,59 @@ +<?xml version="1.0"?> + +<!DOCTYPE html + PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> + +<!-- + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at http://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2022, Peter Johnson (gravatar.com/delphidabbler). + * + * Instructions diplayed on Register Compilers dialogue box. +--> + +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> + + <head> + <title>Register Compilers Configration + + + +

      + If you don't wish to receive notifications like this again you have two + options: +

      +
        +
      1. +

        + Turn off all checks for new compiler installations. + Do this by ticking the Don't show this again check box below. +

        +

        + If you change your mind later you can re-enable the checks from the + Configure Compilers dialogue box. +

        +
        2. +
      2. +

        + Turn notifications on or off on a per-compiler basis. + You need to do this after you have closed this dialogue box, again by + using the Configure Compilers dialogue box. +

        +
        3. +
      +

      + For information about how to configure automatic detection of Delphi + compilers see the Register Compilers with CodeSnip help topic. +

      +

      + Note: only Delphi compilers can be automatically + registered with CodeSnip: this doesn't work with Free Pascal. +

      + + diff --git a/Src/Res/HTML/dlg-rssnews.html b/Src/Res/HTML/dlg-rssnews.html deleted file mode 100644 index c7f1a3a4c..000000000 --- a/Src/Res/HTML/dlg-rssnews.html +++ /dev/null @@ -1,29 +0,0 @@ - - - - - - - - - - dlg-rssnews - - - - - - - - - diff --git a/Src/Res/HTML/dlg-swag-import-intro-tplt.html b/Src/Res/HTML/dlg-swag-import-intro-tplt.html index 4c441390f..e8b2f4967 100644 --- a/Src/Res/HTML/dlg-swag-import-intro-tplt.html +++ b/Src/Res/HTML/dlg-swag-import-intro-tplt.html @@ -2,20 +2,20 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-swag-import-intro.html diff --git a/Src/Res/HTML/dlg-swag-import-outro-tplt.html b/Src/Res/HTML/dlg-swag-import-outro-tplt.html index e43c13afb..a827ab94c 100644 --- a/Src/Res/HTML/dlg-swag-import-outro-tplt.html +++ b/Src/Res/HTML/dlg-swag-import-outro-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + dlg-swag-import-outro-tplt.html diff --git a/Src/Res/HTML/dlg-whatsnew.html b/Src/Res/HTML/dlg-whatsnew.html index ed590adf3..3667ce009 100644 --- a/Src/Res/HTML/dlg-whatsnew.html +++ b/Src/Res/HTML/dlg-whatsnew.html @@ -2,37 +2,28 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + What's New - - -

      - Important information about CodeSnip v4.16.0 -

      There are several important differences from your old version of CodeSnip that you need to know about.

      @@ -72,11 +63,11 @@ You can no longer submit snippets for inclusion in the DelphiDabbler Code Snippets Database.
    • - The news feed has gone away. News will now be posted to the + The news feed has gone away. News will now be posted to the CodeSnip blog CodeSnip blog. You can display the blog in your web browser from the Help menu. + >DelphiDabbler blog. You can display the blog in your web browser from the Help menu.

    diff --git a/Src/Res/HTML/info-basic-tplt.html b/Src/Res/HTML/info-basic-tplt.html index 31889ffe2..a8bfc2f73 100644 --- a/Src/Res/HTML/info-basic-tplt.html +++ b/Src/Res/HTML/info-basic-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + Basic Detail Page diff --git a/Src/Res/HTML/info-empty-selection-tplt.html b/Src/Res/HTML/info-empty-selection-tplt.html index 7990d7913..dd2b9fdd3 100644 --- a/Src/Res/HTML/info-empty-selection-tplt.html +++ b/Src/Res/HTML/info-empty-selection-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + Empty Snippet List @@ -34,5 +34,5 @@

    - + \ No newline at end of file diff --git a/Src/Res/HTML/info-snippet-list-tplt.html b/Src/Res/HTML/info-snippet-list-tplt.html index f1af84732..e762589f9 100644 --- a/Src/Res/HTML/info-snippet-list-tplt.html +++ b/Src/Res/HTML/info-snippet-list-tplt.html @@ -2,20 +2,20 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + Snippet List @@ -39,7 +39,7 @@

    <%SnippetList%> - + - + diff --git a/Src/Res/HTML/info-snippet-tplt.html b/Src/Res/HTML/info-snippet-tplt.html index 008815ada..a362b8bdc 100644 --- a/Src/Res/HTML/info-snippet-tplt.html +++ b/Src/Res/HTML/info-snippet-tplt.html @@ -2,20 +2,20 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + detail-info @@ -29,7 +29,7 @@ - +
    @@ -77,5 +77,5 @@

    - + \ No newline at end of file diff --git a/Src/Res/HTML/welcome-tplt.html b/Src/Res/HTML/welcome-tplt.html index 5fe8b19e9..55a23c116 100644 --- a/Src/Res/HTML/welcome-tplt.html +++ b/Src/Res/HTML/welcome-tplt.html @@ -2,19 +2,19 @@ + "https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> - + Welcome @@ -68,7 +68,7 @@

    - There are <%MainDBCount%> snippets in the DelphiDabbler + There are <%MainDBCount%> snippets in the DelphiDabbler Code Snippets database.
    @@ -189,7 +189,7 @@

    href="#" class="command-link" onclick="showNews();return false;" - >News Blog + >News On DelphiDabbler Blog | diff --git a/Src/Res/Scripts/3rdParty/LICENSE b/Src/Res/Scripts/3rdParty/LICENSE deleted file mode 100644 index 717562f2a..000000000 --- a/Src/Res/Scripts/3rdParty/LICENSE +++ /dev/null @@ -1,10 +0,0 @@ -Files in the Src/Res/Scripts/3rdParty directory are licensed as follows. - -jquery.cycle.lite.js --------------------- -Dual licensed under the MIT or GPL license. It is used here under the MIT -license. See Docs/License.html#jquery-cycle for details. - -jquery-1.8.0.min.js ------------------- -MIT license. See Docs/License.html#jquery for details. \ No newline at end of file diff --git a/Src/Res/Scripts/3rdParty/jquery-1.12.4.min.js b/Src/Res/Scripts/3rdParty/jquery-1.12.4.min.js new file mode 100644 index 000000000..b0ecaddee --- /dev/null +++ b/Src/Res/Scripts/3rdParty/jquery-1.12.4.min.js @@ -0,0 +1,5 @@ +/*! jQuery v1.12.4 | (c) jQuery Foundation | jquery.org/license */ +!function(a,b){"object"==typeof module&&"object"==typeof module.exports?module.exports=a.document?b(a,!0):function(a){if(!a.document)throw new Error("jQuery requires a window with a document");return b(a)}:b(a)}("undefined"!=typeof window?window:this,function(a,b){var c=[],d=a.document,e=c.slice,f=c.concat,g=c.push,h=c.indexOf,i={},j=i.toString,k=i.hasOwnProperty,l={},m="1.12.4",n=function(a,b){return new n.fn.init(a,b)},o=/^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g,p=/^-ms-/,q=/-([\da-z])/gi,r=function(a,b){return b.toUpperCase()};n.fn=n.prototype={jquery:m,constructor:n,selector:"",length:0,toArray:function(){return e.call(this)},get:function(a){return null!=a?0>a?this[a+this.length]:this[a]:e.call(this)},pushStack:function(a){var b=n.merge(this.constructor(),a);return b.prevObject=this,b.context=this.context,b},each:function(a){return n.each(this,a)},map:function(a){return this.pushStack(n.map(this,function(b,c){return a.call(b,c,b)}))},slice:function(){return this.pushStack(e.apply(this,arguments))},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},eq:function(a){var b=this.length,c=+a+(0>a?b:0);return this.pushStack(c>=0&&b>c?[this[c]]:[])},end:function(){return this.prevObject||this.constructor()},push:g,sort:c.sort,splice:c.splice},n.extend=n.fn.extend=function(){var a,b,c,d,e,f,g=arguments[0]||{},h=1,i=arguments.length,j=!1;for("boolean"==typeof g&&(j=g,g=arguments[h]||{},h++),"object"==typeof g||n.isFunction(g)||(g={}),h===i&&(g=this,h--);i>h;h++)if(null!=(e=arguments[h]))for(d in e)a=g[d],c=e[d],g!==c&&(j&&c&&(n.isPlainObject(c)||(b=n.isArray(c)))?(b?(b=!1,f=a&&n.isArray(a)?a:[]):f=a&&n.isPlainObject(a)?a:{},g[d]=n.extend(j,f,c)):void 0!==c&&(g[d]=c));return g},n.extend({expando:"jQuery"+(m+Math.random()).replace(/\D/g,""),isReady:!0,error:function(a){throw new Error(a)},noop:function(){},isFunction:function(a){return"function"===n.type(a)},isArray:Array.isArray||function(a){return"array"===n.type(a)},isWindow:function(a){return null!=a&&a==a.window},isNumeric:function(a){var b=a&&a.toString();return!n.isArray(a)&&b-parseFloat(b)+1>=0},isEmptyObject:function(a){var b;for(b in a)return!1;return!0},isPlainObject:function(a){var b;if(!a||"object"!==n.type(a)||a.nodeType||n.isWindow(a))return!1;try{if(a.constructor&&!k.call(a,"constructor")&&!k.call(a.constructor.prototype,"isPrototypeOf"))return!1}catch(c){return!1}if(!l.ownFirst)for(b in a)return k.call(a,b);for(b in a);return void 0===b||k.call(a,b)},type:function(a){return null==a?a+"":"object"==typeof a||"function"==typeof a?i[j.call(a)]||"object":typeof a},globalEval:function(b){b&&n.trim(b)&&(a.execScript||function(b){a.eval.call(a,b)})(b)},camelCase:function(a){return a.replace(p,"ms-").replace(q,r)},nodeName:function(a,b){return a.nodeName&&a.nodeName.toLowerCase()===b.toLowerCase()},each:function(a,b){var c,d=0;if(s(a)){for(c=a.length;c>d;d++)if(b.call(a[d],d,a[d])===!1)break}else for(d in a)if(b.call(a[d],d,a[d])===!1)break;return a},trim:function(a){return null==a?"":(a+"").replace(o,"")},makeArray:function(a,b){var c=b||[];return null!=a&&(s(Object(a))?n.merge(c,"string"==typeof a?[a]:a):g.call(c,a)),c},inArray:function(a,b,c){var d;if(b){if(h)return h.call(b,a,c);for(d=b.length,c=c?0>c?Math.max(0,d+c):c:0;d>c;c++)if(c in b&&b[c]===a)return c}return-1},merge:function(a,b){var c=+b.length,d=0,e=a.length;while(c>d)a[e++]=b[d++];if(c!==c)while(void 0!==b[d])a[e++]=b[d++];return a.length=e,a},grep:function(a,b,c){for(var d,e=[],f=0,g=a.length,h=!c;g>f;f++)d=!b(a[f],f),d!==h&&e.push(a[f]);return e},map:function(a,b,c){var d,e,g=0,h=[];if(s(a))for(d=a.length;d>g;g++)e=b(a[g],g,c),null!=e&&h.push(e);else for(g in a)e=b(a[g],g,c),null!=e&&h.push(e);return f.apply([],h)},guid:1,proxy:function(a,b){var c,d,f;return"string"==typeof b&&(f=a[b],b=a,a=f),n.isFunction(a)?(c=e.call(arguments,2),d=function(){return a.apply(b||this,c.concat(e.call(arguments)))},d.guid=a.guid=a.guid||n.guid++,d):void 0},now:function(){return+new Date},support:l}),"function"==typeof Symbol&&(n.fn[Symbol.iterator]=c[Symbol.iterator]),n.each("Boolean Number String Function Array Date RegExp Object Error Symbol".split(" "),function(a,b){i["[object "+b+"]"]=b.toLowerCase()});function s(a){var b=!!a&&"length"in a&&a.length,c=n.type(a);return"function"===c||n.isWindow(a)?!1:"array"===c||0===b||"number"==typeof b&&b>0&&b-1 in a}var t=function(a){var b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u="sizzle"+1*new Date,v=a.document,w=0,x=0,y=ga(),z=ga(),A=ga(),B=function(a,b){return a===b&&(l=!0),0},C=1<<31,D={}.hasOwnProperty,E=[],F=E.pop,G=E.push,H=E.push,I=E.slice,J=function(a,b){for(var c=0,d=a.length;d>c;c++)if(a[c]===b)return c;return-1},K="checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped",L="[\\x20\\t\\r\\n\\f]",M="(?:\\\\.|[\\w-]|[^\\x00-\\xa0])+",N="\\["+L+"*("+M+")(?:"+L+"*([*^$|!~]?=)"+L+"*(?:'((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\"|("+M+"))|)"+L+"*\\]",O=":("+M+")(?:\\((('((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\")|((?:\\\\.|[^\\\\()[\\]]|"+N+")*)|.*)\\)|)",P=new RegExp(L+"+","g"),Q=new RegExp("^"+L+"+|((?:^|[^\\\\])(?:\\\\.)*)"+L+"+$","g"),R=new RegExp("^"+L+"*,"+L+"*"),S=new RegExp("^"+L+"*([>+~]|"+L+")"+L+"*"),T=new RegExp("="+L+"*([^\\]'\"]*?)"+L+"*\\]","g"),U=new RegExp(O),V=new RegExp("^"+M+"$"),W={ID:new RegExp("^#("+M+")"),CLASS:new RegExp("^\\.("+M+")"),TAG:new RegExp("^("+M+"|[*])"),ATTR:new RegExp("^"+N),PSEUDO:new RegExp("^"+O),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+L+"*(even|odd|(([+-]|)(\\d*)n|)"+L+"*(?:([+-]|)"+L+"*(\\d+)|))"+L+"*\\)|)","i"),bool:new RegExp("^(?:"+K+")$","i"),needsContext:new RegExp("^"+L+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+L+"*((?:-\\d)?\\d*)"+L+"*\\)|)(?=[^-]|$)","i")},X=/^(?:input|select|textarea|button)$/i,Y=/^h\d$/i,Z=/^[^{]+\{\s*\[native \w/,$=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,_=/[+~]/,aa=/'|\\/g,ba=new RegExp("\\\\([\\da-f]{1,6}"+L+"?|("+L+")|.)","ig"),ca=function(a,b,c){var d="0x"+b-65536;return d!==d||c?b:0>d?String.fromCharCode(d+65536):String.fromCharCode(d>>10|55296,1023&d|56320)},da=function(){m()};try{H.apply(E=I.call(v.childNodes),v.childNodes),E[v.childNodes.length].nodeType}catch(ea){H={apply:E.length?function(a,b){G.apply(a,I.call(b))}:function(a,b){var c=a.length,d=0;while(a[c++]=b[d++]);a.length=c-1}}}function fa(a,b,d,e){var f,h,j,k,l,o,r,s,w=b&&b.ownerDocument,x=b?b.nodeType:9;if(d=d||[],"string"!=typeof a||!a||1!==x&&9!==x&&11!==x)return d;if(!e&&((b?b.ownerDocument||b:v)!==n&&m(b),b=b||n,p)){if(11!==x&&(o=$.exec(a)))if(f=o[1]){if(9===x){if(!(j=b.getElementById(f)))return d;if(j.id===f)return d.push(j),d}else if(w&&(j=w.getElementById(f))&&t(b,j)&&j.id===f)return d.push(j),d}else{if(o[2])return H.apply(d,b.getElementsByTagName(a)),d;if((f=o[3])&&c.getElementsByClassName&&b.getElementsByClassName)return H.apply(d,b.getElementsByClassName(f)),d}if(c.qsa&&!A[a+" "]&&(!q||!q.test(a))){if(1!==x)w=b,s=a;else if("object"!==b.nodeName.toLowerCase()){(k=b.getAttribute("id"))?k=k.replace(aa,"\\$&"):b.setAttribute("id",k=u),r=g(a),h=r.length,l=V.test(k)?"#"+k:"[id='"+k+"']";while(h--)r[h]=l+" "+qa(r[h]);s=r.join(","),w=_.test(a)&&oa(b.parentNode)||b}if(s)try{return H.apply(d,w.querySelectorAll(s)),d}catch(y){}finally{k===u&&b.removeAttribute("id")}}}return i(a.replace(Q,"$1"),b,d,e)}function ga(){var a=[];function b(c,e){return a.push(c+" ")>d.cacheLength&&delete b[a.shift()],b[c+" "]=e}return b}function ha(a){return a[u]=!0,a}function ia(a){var b=n.createElement("div");try{return!!a(b)}catch(c){return!1}finally{b.parentNode&&b.parentNode.removeChild(b),b=null}}function ja(a,b){var c=a.split("|"),e=c.length;while(e--)d.attrHandle[c[e]]=b}function ka(a,b){var c=b&&a,d=c&&1===a.nodeType&&1===b.nodeType&&(~b.sourceIndex||C)-(~a.sourceIndex||C);if(d)return d;if(c)while(c=c.nextSibling)if(c===b)return-1;return a?1:-1}function la(a){return function(b){var c=b.nodeName.toLowerCase();return"input"===c&&b.type===a}}function ma(a){return function(b){var c=b.nodeName.toLowerCase();return("input"===c||"button"===c)&&b.type===a}}function na(a){return ha(function(b){return b=+b,ha(function(c,d){var e,f=a([],c.length,b),g=f.length;while(g--)c[e=f[g]]&&(c[e]=!(d[e]=c[e]))})})}function oa(a){return a&&"undefined"!=typeof a.getElementsByTagName&&a}c=fa.support={},f=fa.isXML=function(a){var b=a&&(a.ownerDocument||a).documentElement;return b?"HTML"!==b.nodeName:!1},m=fa.setDocument=function(a){var b,e,g=a?a.ownerDocument||a:v;return g!==n&&9===g.nodeType&&g.documentElement?(n=g,o=n.documentElement,p=!f(n),(e=n.defaultView)&&e.top!==e&&(e.addEventListener?e.addEventListener("unload",da,!1):e.attachEvent&&e.attachEvent("onunload",da)),c.attributes=ia(function(a){return a.className="i",!a.getAttribute("className")}),c.getElementsByTagName=ia(function(a){return a.appendChild(n.createComment("")),!a.getElementsByTagName("*").length}),c.getElementsByClassName=Z.test(n.getElementsByClassName),c.getById=ia(function(a){return o.appendChild(a).id=u,!n.getElementsByName||!n.getElementsByName(u).length}),c.getById?(d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c=b.getElementById(a);return c?[c]:[]}},d.filter.ID=function(a){var b=a.replace(ba,ca);return function(a){return a.getAttribute("id")===b}}):(delete d.find.ID,d.filter.ID=function(a){var b=a.replace(ba,ca);return function(a){var c="undefined"!=typeof a.getAttributeNode&&a.getAttributeNode("id");return c&&c.value===b}}),d.find.TAG=c.getElementsByTagName?function(a,b){return"undefined"!=typeof b.getElementsByTagName?b.getElementsByTagName(a):c.qsa?b.querySelectorAll(a):void 0}:function(a,b){var c,d=[],e=0,f=b.getElementsByTagName(a);if("*"===a){while(c=f[e++])1===c.nodeType&&d.push(c);return d}return f},d.find.CLASS=c.getElementsByClassName&&function(a,b){return"undefined"!=typeof b.getElementsByClassName&&p?b.getElementsByClassName(a):void 0},r=[],q=[],(c.qsa=Z.test(n.querySelectorAll))&&(ia(function(a){o.appendChild(a).innerHTML="",a.querySelectorAll("[msallowcapture^='']").length&&q.push("[*^$]="+L+"*(?:''|\"\")"),a.querySelectorAll("[selected]").length||q.push("\\["+L+"*(?:value|"+K+")"),a.querySelectorAll("[id~="+u+"-]").length||q.push("~="),a.querySelectorAll(":checked").length||q.push(":checked"),a.querySelectorAll("a#"+u+"+*").length||q.push(".#.+[+~]")}),ia(function(a){var b=n.createElement("input");b.setAttribute("type","hidden"),a.appendChild(b).setAttribute("name","D"),a.querySelectorAll("[name=d]").length&&q.push("name"+L+"*[*^$|!~]?="),a.querySelectorAll(":enabled").length||q.push(":enabled",":disabled"),a.querySelectorAll("*,:x"),q.push(",.*:")})),(c.matchesSelector=Z.test(s=o.matches||o.webkitMatchesSelector||o.mozMatchesSelector||o.oMatchesSelector||o.msMatchesSelector))&&ia(function(a){c.disconnectedMatch=s.call(a,"div"),s.call(a,"[s!='']:x"),r.push("!=",O)}),q=q.length&&new RegExp(q.join("|")),r=r.length&&new RegExp(r.join("|")),b=Z.test(o.compareDocumentPosition),t=b||Z.test(o.contains)?function(a,b){var c=9===a.nodeType?a.documentElement:a,d=b&&b.parentNode;return a===d||!(!d||1!==d.nodeType||!(c.contains?c.contains(d):a.compareDocumentPosition&&16&a.compareDocumentPosition(d)))}:function(a,b){if(b)while(b=b.parentNode)if(b===a)return!0;return!1},B=b?function(a,b){if(a===b)return l=!0,0;var d=!a.compareDocumentPosition-!b.compareDocumentPosition;return d?d:(d=(a.ownerDocument||a)===(b.ownerDocument||b)?a.compareDocumentPosition(b):1,1&d||!c.sortDetached&&b.compareDocumentPosition(a)===d?a===n||a.ownerDocument===v&&t(v,a)?-1:b===n||b.ownerDocument===v&&t(v,b)?1:k?J(k,a)-J(k,b):0:4&d?-1:1)}:function(a,b){if(a===b)return l=!0,0;var c,d=0,e=a.parentNode,f=b.parentNode,g=[a],h=[b];if(!e||!f)return a===n?-1:b===n?1:e?-1:f?1:k?J(k,a)-J(k,b):0;if(e===f)return ka(a,b);c=a;while(c=c.parentNode)g.unshift(c);c=b;while(c=c.parentNode)h.unshift(c);while(g[d]===h[d])d++;return d?ka(g[d],h[d]):g[d]===v?-1:h[d]===v?1:0},n):n},fa.matches=function(a,b){return fa(a,null,null,b)},fa.matchesSelector=function(a,b){if((a.ownerDocument||a)!==n&&m(a),b=b.replace(T,"='$1']"),c.matchesSelector&&p&&!A[b+" "]&&(!r||!r.test(b))&&(!q||!q.test(b)))try{var d=s.call(a,b);if(d||c.disconnectedMatch||a.document&&11!==a.document.nodeType)return d}catch(e){}return fa(b,n,null,[a]).length>0},fa.contains=function(a,b){return(a.ownerDocument||a)!==n&&m(a),t(a,b)},fa.attr=function(a,b){(a.ownerDocument||a)!==n&&m(a);var e=d.attrHandle[b.toLowerCase()],f=e&&D.call(d.attrHandle,b.toLowerCase())?e(a,b,!p):void 0;return void 0!==f?f:c.attributes||!p?a.getAttribute(b):(f=a.getAttributeNode(b))&&f.specified?f.value:null},fa.error=function(a){throw new Error("Syntax error, unrecognized expression: "+a)},fa.uniqueSort=function(a){var b,d=[],e=0,f=0;if(l=!c.detectDuplicates,k=!c.sortStable&&a.slice(0),a.sort(B),l){while(b=a[f++])b===a[f]&&(e=d.push(f));while(e--)a.splice(d[e],1)}return k=null,a},e=fa.getText=function(a){var b,c="",d=0,f=a.nodeType;if(f){if(1===f||9===f||11===f){if("string"==typeof a.textContent)return a.textContent;for(a=a.firstChild;a;a=a.nextSibling)c+=e(a)}else if(3===f||4===f)return a.nodeValue}else while(b=a[d++])c+=e(b);return c},d=fa.selectors={cacheLength:50,createPseudo:ha,match:W,attrHandle:{},find:{},relative:{">":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(a){return a[1]=a[1].replace(ba,ca),a[3]=(a[3]||a[4]||a[5]||"").replace(ba,ca),"~="===a[2]&&(a[3]=" "+a[3]+" "),a.slice(0,4)},CHILD:function(a){return a[1]=a[1].toLowerCase(),"nth"===a[1].slice(0,3)?(a[3]||fa.error(a[0]),a[4]=+(a[4]?a[5]+(a[6]||1):2*("even"===a[3]||"odd"===a[3])),a[5]=+(a[7]+a[8]||"odd"===a[3])):a[3]&&fa.error(a[0]),a},PSEUDO:function(a){var b,c=!a[6]&&a[2];return W.CHILD.test(a[0])?null:(a[3]?a[2]=a[4]||a[5]||"":c&&U.test(c)&&(b=g(c,!0))&&(b=c.indexOf(")",c.length-b)-c.length)&&(a[0]=a[0].slice(0,b),a[2]=c.slice(0,b)),a.slice(0,3))}},filter:{TAG:function(a){var b=a.replace(ba,ca).toLowerCase();return"*"===a?function(){return!0}:function(a){return a.nodeName&&a.nodeName.toLowerCase()===b}},CLASS:function(a){var b=y[a+" "];return b||(b=new RegExp("(^|"+L+")"+a+"("+L+"|$)"))&&y(a,function(a){return b.test("string"==typeof a.className&&a.className||"undefined"!=typeof a.getAttribute&&a.getAttribute("class")||"")})},ATTR:function(a,b,c){return function(d){var e=fa.attr(d,a);return null==e?"!="===b:b?(e+="","="===b?e===c:"!="===b?e!==c:"^="===b?c&&0===e.indexOf(c):"*="===b?c&&e.indexOf(c)>-1:"$="===b?c&&e.slice(-c.length)===c:"~="===b?(" "+e.replace(P," ")+" ").indexOf(c)>-1:"|="===b?e===c||e.slice(0,c.length+1)===c+"-":!1):!0}},CHILD:function(a,b,c,d,e){var f="nth"!==a.slice(0,3),g="last"!==a.slice(-4),h="of-type"===b;return 1===d&&0===e?function(a){return!!a.parentNode}:function(b,c,i){var j,k,l,m,n,o,p=f!==g?"nextSibling":"previousSibling",q=b.parentNode,r=h&&b.nodeName.toLowerCase(),s=!i&&!h,t=!1;if(q){if(f){while(p){m=b;while(m=m[p])if(h?m.nodeName.toLowerCase()===r:1===m.nodeType)return!1;o=p="only"===a&&!o&&"nextSibling"}return!0}if(o=[g?q.firstChild:q.lastChild],g&&s){m=q,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n&&j[2],m=n&&q.childNodes[n];while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if(1===m.nodeType&&++t&&m===b){k[a]=[w,n,t];break}}else if(s&&(m=b,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n),t===!1)while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if((h?m.nodeName.toLowerCase()===r:1===m.nodeType)&&++t&&(s&&(l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),k[a]=[w,t]),m===b))break;return t-=e,t===d||t%d===0&&t/d>=0}}},PSEUDO:function(a,b){var c,e=d.pseudos[a]||d.setFilters[a.toLowerCase()]||fa.error("unsupported pseudo: "+a);return e[u]?e(b):e.length>1?(c=[a,a,"",b],d.setFilters.hasOwnProperty(a.toLowerCase())?ha(function(a,c){var d,f=e(a,b),g=f.length;while(g--)d=J(a,f[g]),a[d]=!(c[d]=f[g])}):function(a){return e(a,0,c)}):e}},pseudos:{not:ha(function(a){var b=[],c=[],d=h(a.replace(Q,"$1"));return d[u]?ha(function(a,b,c,e){var f,g=d(a,null,e,[]),h=a.length;while(h--)(f=g[h])&&(a[h]=!(b[h]=f))}):function(a,e,f){return b[0]=a,d(b,null,f,c),b[0]=null,!c.pop()}}),has:ha(function(a){return function(b){return fa(a,b).length>0}}),contains:ha(function(a){return a=a.replace(ba,ca),function(b){return(b.textContent||b.innerText||e(b)).indexOf(a)>-1}}),lang:ha(function(a){return V.test(a||"")||fa.error("unsupported lang: "+a),a=a.replace(ba,ca).toLowerCase(),function(b){var c;do if(c=p?b.lang:b.getAttribute("xml:lang")||b.getAttribute("lang"))return c=c.toLowerCase(),c===a||0===c.indexOf(a+"-");while((b=b.parentNode)&&1===b.nodeType);return!1}}),target:function(b){var c=a.location&&a.location.hash;return c&&c.slice(1)===b.id},root:function(a){return a===o},focus:function(a){return a===n.activeElement&&(!n.hasFocus||n.hasFocus())&&!!(a.type||a.href||~a.tabIndex)},enabled:function(a){return a.disabled===!1},disabled:function(a){return a.disabled===!0},checked:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&!!a.checked||"option"===b&&!!a.selected},selected:function(a){return a.parentNode&&a.parentNode.selectedIndex,a.selected===!0},empty:function(a){for(a=a.firstChild;a;a=a.nextSibling)if(a.nodeType<6)return!1;return!0},parent:function(a){return!d.pseudos.empty(a)},header:function(a){return Y.test(a.nodeName)},input:function(a){return X.test(a.nodeName)},button:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&"button"===a.type||"button"===b},text:function(a){var b;return"input"===a.nodeName.toLowerCase()&&"text"===a.type&&(null==(b=a.getAttribute("type"))||"text"===b.toLowerCase())},first:na(function(){return[0]}),last:na(function(a,b){return[b-1]}),eq:na(function(a,b,c){return[0>c?c+b:c]}),even:na(function(a,b){for(var c=0;b>c;c+=2)a.push(c);return a}),odd:na(function(a,b){for(var c=1;b>c;c+=2)a.push(c);return a}),lt:na(function(a,b,c){for(var d=0>c?c+b:c;--d>=0;)a.push(d);return a}),gt:na(function(a,b,c){for(var d=0>c?c+b:c;++db;b++)d+=a[b].value;return d}function ra(a,b,c){var d=b.dir,e=c&&"parentNode"===d,f=x++;return b.first?function(b,c,f){while(b=b[d])if(1===b.nodeType||e)return a(b,c,f)}:function(b,c,g){var h,i,j,k=[w,f];if(g){while(b=b[d])if((1===b.nodeType||e)&&a(b,c,g))return!0}else while(b=b[d])if(1===b.nodeType||e){if(j=b[u]||(b[u]={}),i=j[b.uniqueID]||(j[b.uniqueID]={}),(h=i[d])&&h[0]===w&&h[1]===f)return k[2]=h[2];if(i[d]=k,k[2]=a(b,c,g))return!0}}}function sa(a){return a.length>1?function(b,c,d){var e=a.length;while(e--)if(!a[e](b,c,d))return!1;return!0}:a[0]}function ta(a,b,c){for(var d=0,e=b.length;e>d;d++)fa(a,b[d],c);return c}function ua(a,b,c,d,e){for(var f,g=[],h=0,i=a.length,j=null!=b;i>h;h++)(f=a[h])&&(c&&!c(f,d,e)||(g.push(f),j&&b.push(h)));return g}function va(a,b,c,d,e,f){return d&&!d[u]&&(d=va(d)),e&&!e[u]&&(e=va(e,f)),ha(function(f,g,h,i){var j,k,l,m=[],n=[],o=g.length,p=f||ta(b||"*",h.nodeType?[h]:h,[]),q=!a||!f&&b?p:ua(p,m,a,h,i),r=c?e||(f?a:o||d)?[]:g:q;if(c&&c(q,r,h,i),d){j=ua(r,n),d(j,[],h,i),k=j.length;while(k--)(l=j[k])&&(r[n[k]]=!(q[n[k]]=l))}if(f){if(e||a){if(e){j=[],k=r.length;while(k--)(l=r[k])&&j.push(q[k]=l);e(null,r=[],j,i)}k=r.length;while(k--)(l=r[k])&&(j=e?J(f,l):m[k])>-1&&(f[j]=!(g[j]=l))}}else r=ua(r===g?r.splice(o,r.length):r),e?e(null,g,r,i):H.apply(g,r)})}function wa(a){for(var b,c,e,f=a.length,g=d.relative[a[0].type],h=g||d.relative[" "],i=g?1:0,k=ra(function(a){return a===b},h,!0),l=ra(function(a){return J(b,a)>-1},h,!0),m=[function(a,c,d){var e=!g&&(d||c!==j)||((b=c).nodeType?k(a,c,d):l(a,c,d));return b=null,e}];f>i;i++)if(c=d.relative[a[i].type])m=[ra(sa(m),c)];else{if(c=d.filter[a[i].type].apply(null,a[i].matches),c[u]){for(e=++i;f>e;e++)if(d.relative[a[e].type])break;return va(i>1&&sa(m),i>1&&qa(a.slice(0,i-1).concat({value:" "===a[i-2].type?"*":""})).replace(Q,"$1"),c,e>i&&wa(a.slice(i,e)),f>e&&wa(a=a.slice(e)),f>e&&qa(a))}m.push(c)}return sa(m)}function xa(a,b){var c=b.length>0,e=a.length>0,f=function(f,g,h,i,k){var l,o,q,r=0,s="0",t=f&&[],u=[],v=j,x=f||e&&d.find.TAG("*",k),y=w+=null==v?1:Math.random()||.1,z=x.length;for(k&&(j=g===n||g||k);s!==z&&null!=(l=x[s]);s++){if(e&&l){o=0,g||l.ownerDocument===n||(m(l),h=!p);while(q=a[o++])if(q(l,g||n,h)){i.push(l);break}k&&(w=y)}c&&((l=!q&&l)&&r--,f&&t.push(l))}if(r+=s,c&&s!==r){o=0;while(q=b[o++])q(t,u,g,h);if(f){if(r>0)while(s--)t[s]||u[s]||(u[s]=F.call(i));u=ua(u)}H.apply(i,u),k&&!f&&u.length>0&&r+b.length>1&&fa.uniqueSort(i)}return k&&(w=y,j=v),t};return c?ha(f):f}return h=fa.compile=function(a,b){var c,d=[],e=[],f=A[a+" "];if(!f){b||(b=g(a)),c=b.length;while(c--)f=wa(b[c]),f[u]?d.push(f):e.push(f);f=A(a,xa(e,d)),f.selector=a}return f},i=fa.select=function(a,b,e,f){var i,j,k,l,m,n="function"==typeof a&&a,o=!f&&g(a=n.selector||a);if(e=e||[],1===o.length){if(j=o[0]=o[0].slice(0),j.length>2&&"ID"===(k=j[0]).type&&c.getById&&9===b.nodeType&&p&&d.relative[j[1].type]){if(b=(d.find.ID(k.matches[0].replace(ba,ca),b)||[])[0],!b)return e;n&&(b=b.parentNode),a=a.slice(j.shift().value.length)}i=W.needsContext.test(a)?0:j.length;while(i--){if(k=j[i],d.relative[l=k.type])break;if((m=d.find[l])&&(f=m(k.matches[0].replace(ba,ca),_.test(j[0].type)&&oa(b.parentNode)||b))){if(j.splice(i,1),a=f.length&&qa(j),!a)return H.apply(e,f),e;break}}}return(n||h(a,o))(f,b,!p,e,!b||_.test(a)&&oa(b.parentNode)||b),e},c.sortStable=u.split("").sort(B).join("")===u,c.detectDuplicates=!!l,m(),c.sortDetached=ia(function(a){return 1&a.compareDocumentPosition(n.createElement("div"))}),ia(function(a){return a.innerHTML="","#"===a.firstChild.getAttribute("href")})||ja("type|href|height|width",function(a,b,c){return c?void 0:a.getAttribute(b,"type"===b.toLowerCase()?1:2)}),c.attributes&&ia(function(a){return a.innerHTML="",a.firstChild.setAttribute("value",""),""===a.firstChild.getAttribute("value")})||ja("value",function(a,b,c){return c||"input"!==a.nodeName.toLowerCase()?void 0:a.defaultValue}),ia(function(a){return null==a.getAttribute("disabled")})||ja(K,function(a,b,c){var d;return c?void 0:a[b]===!0?b.toLowerCase():(d=a.getAttributeNode(b))&&d.specified?d.value:null}),fa}(a);n.find=t,n.expr=t.selectors,n.expr[":"]=n.expr.pseudos,n.uniqueSort=n.unique=t.uniqueSort,n.text=t.getText,n.isXMLDoc=t.isXML,n.contains=t.contains;var u=function(a,b,c){var d=[],e=void 0!==c;while((a=a[b])&&9!==a.nodeType)if(1===a.nodeType){if(e&&n(a).is(c))break;d.push(a)}return d},v=function(a,b){for(var c=[];a;a=a.nextSibling)1===a.nodeType&&a!==b&&c.push(a);return c},w=n.expr.match.needsContext,x=/^<([\w-]+)\s*\/?>(?:<\/\1>|)$/,y=/^.[^:#\[\.,]*$/;function z(a,b,c){if(n.isFunction(b))return n.grep(a,function(a,d){return!!b.call(a,d,a)!==c});if(b.nodeType)return n.grep(a,function(a){return a===b!==c});if("string"==typeof b){if(y.test(b))return n.filter(b,a,c);b=n.filter(b,a)}return n.grep(a,function(a){return n.inArray(a,b)>-1!==c})}n.filter=function(a,b,c){var d=b[0];return c&&(a=":not("+a+")"),1===b.length&&1===d.nodeType?n.find.matchesSelector(d,a)?[d]:[]:n.find.matches(a,n.grep(b,function(a){return 1===a.nodeType}))},n.fn.extend({find:function(a){var b,c=[],d=this,e=d.length;if("string"!=typeof a)return this.pushStack(n(a).filter(function(){for(b=0;e>b;b++)if(n.contains(d[b],this))return!0}));for(b=0;e>b;b++)n.find(a,d[b],c);return c=this.pushStack(e>1?n.unique(c):c),c.selector=this.selector?this.selector+" "+a:a,c},filter:function(a){return this.pushStack(z(this,a||[],!1))},not:function(a){return this.pushStack(z(this,a||[],!0))},is:function(a){return!!z(this,"string"==typeof a&&w.test(a)?n(a):a||[],!1).length}});var A,B=/^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]*))$/,C=n.fn.init=function(a,b,c){var e,f;if(!a)return this;if(c=c||A,"string"==typeof a){if(e="<"===a.charAt(0)&&">"===a.charAt(a.length-1)&&a.length>=3?[null,a,null]:B.exec(a),!e||!e[1]&&b)return!b||b.jquery?(b||c).find(a):this.constructor(b).find(a);if(e[1]){if(b=b instanceof n?b[0]:b,n.merge(this,n.parseHTML(e[1],b&&b.nodeType?b.ownerDocument||b:d,!0)),x.test(e[1])&&n.isPlainObject(b))for(e in b)n.isFunction(this[e])?this[e](b[e]):this.attr(e,b[e]);return this}if(f=d.getElementById(e[2]),f&&f.parentNode){if(f.id!==e[2])return A.find(a);this.length=1,this[0]=f}return this.context=d,this.selector=a,this}return a.nodeType?(this.context=this[0]=a,this.length=1,this):n.isFunction(a)?"undefined"!=typeof c.ready?c.ready(a):a(n):(void 0!==a.selector&&(this.selector=a.selector,this.context=a.context),n.makeArray(a,this))};C.prototype=n.fn,A=n(d);var D=/^(?:parents|prev(?:Until|All))/,E={children:!0,contents:!0,next:!0,prev:!0};n.fn.extend({has:function(a){var b,c=n(a,this),d=c.length;return this.filter(function(){for(b=0;d>b;b++)if(n.contains(this,c[b]))return!0})},closest:function(a,b){for(var c,d=0,e=this.length,f=[],g=w.test(a)||"string"!=typeof a?n(a,b||this.context):0;e>d;d++)for(c=this[d];c&&c!==b;c=c.parentNode)if(c.nodeType<11&&(g?g.index(c)>-1:1===c.nodeType&&n.find.matchesSelector(c,a))){f.push(c);break}return this.pushStack(f.length>1?n.uniqueSort(f):f)},index:function(a){return a?"string"==typeof a?n.inArray(this[0],n(a)):n.inArray(a.jquery?a[0]:a,this):this[0]&&this[0].parentNode?this.first().prevAll().length:-1},add:function(a,b){return this.pushStack(n.uniqueSort(n.merge(this.get(),n(a,b))))},addBack:function(a){return this.add(null==a?this.prevObject:this.prevObject.filter(a))}});function F(a,b){do a=a[b];while(a&&1!==a.nodeType);return a}n.each({parent:function(a){var b=a.parentNode;return b&&11!==b.nodeType?b:null},parents:function(a){return u(a,"parentNode")},parentsUntil:function(a,b,c){return u(a,"parentNode",c)},next:function(a){return F(a,"nextSibling")},prev:function(a){return F(a,"previousSibling")},nextAll:function(a){return u(a,"nextSibling")},prevAll:function(a){return u(a,"previousSibling")},nextUntil:function(a,b,c){return u(a,"nextSibling",c)},prevUntil:function(a,b,c){return u(a,"previousSibling",c)},siblings:function(a){return v((a.parentNode||{}).firstChild,a)},children:function(a){return v(a.firstChild)},contents:function(a){return n.nodeName(a,"iframe")?a.contentDocument||a.contentWindow.document:n.merge([],a.childNodes)}},function(a,b){n.fn[a]=function(c,d){var e=n.map(this,b,c);return"Until"!==a.slice(-5)&&(d=c),d&&"string"==typeof d&&(e=n.filter(d,e)),this.length>1&&(E[a]||(e=n.uniqueSort(e)),D.test(a)&&(e=e.reverse())),this.pushStack(e)}});var G=/\S+/g;function H(a){var b={};return n.each(a.match(G)||[],function(a,c){b[c]=!0}),b}n.Callbacks=function(a){a="string"==typeof a?H(a):n.extend({},a);var b,c,d,e,f=[],g=[],h=-1,i=function(){for(e=a.once,d=b=!0;g.length;h=-1){c=g.shift();while(++h-1)f.splice(c,1),h>=c&&h--}),this},has:function(a){return a?n.inArray(a,f)>-1:f.length>0},empty:function(){return f&&(f=[]),this},disable:function(){return e=g=[],f=c="",this},disabled:function(){return!f},lock:function(){return e=!0,c||j.disable(),this},locked:function(){return!!e},fireWith:function(a,c){return e||(c=c||[],c=[a,c.slice?c.slice():c],g.push(c),b||i()),this},fire:function(){return j.fireWith(this,arguments),this},fired:function(){return!!d}};return j},n.extend({Deferred:function(a){var b=[["resolve","done",n.Callbacks("once memory"),"resolved"],["reject","fail",n.Callbacks("once memory"),"rejected"],["notify","progress",n.Callbacks("memory")]],c="pending",d={state:function(){return c},always:function(){return e.done(arguments).fail(arguments),this},then:function(){var a=arguments;return n.Deferred(function(c){n.each(b,function(b,f){var g=n.isFunction(a[b])&&a[b];e[f[1]](function(){var a=g&&g.apply(this,arguments);a&&n.isFunction(a.promise)?a.promise().progress(c.notify).done(c.resolve).fail(c.reject):c[f[0]+"With"](this===d?c.promise():this,g?[a]:arguments)})}),a=null}).promise()},promise:function(a){return null!=a?n.extend(a,d):d}},e={};return d.pipe=d.then,n.each(b,function(a,f){var g=f[2],h=f[3];d[f[1]]=g.add,h&&g.add(function(){c=h},b[1^a][2].disable,b[2][2].lock),e[f[0]]=function(){return e[f[0]+"With"](this===e?d:this,arguments),this},e[f[0]+"With"]=g.fireWith}),d.promise(e),a&&a.call(e,e),e},when:function(a){var b=0,c=e.call(arguments),d=c.length,f=1!==d||a&&n.isFunction(a.promise)?d:0,g=1===f?a:n.Deferred(),h=function(a,b,c){return function(d){b[a]=this,c[a]=arguments.length>1?e.call(arguments):d,c===i?g.notifyWith(b,c):--f||g.resolveWith(b,c)}},i,j,k;if(d>1)for(i=new Array(d),j=new Array(d),k=new Array(d);d>b;b++)c[b]&&n.isFunction(c[b].promise)?c[b].promise().progress(h(b,j,i)).done(h(b,k,c)).fail(g.reject):--f;return f||g.resolveWith(k,c),g.promise()}});var I;n.fn.ready=function(a){return n.ready.promise().done(a),this},n.extend({isReady:!1,readyWait:1,holdReady:function(a){a?n.readyWait++:n.ready(!0)},ready:function(a){(a===!0?--n.readyWait:n.isReady)||(n.isReady=!0,a!==!0&&--n.readyWait>0||(I.resolveWith(d,[n]),n.fn.triggerHandler&&(n(d).triggerHandler("ready"),n(d).off("ready"))))}});function J(){d.addEventListener?(d.removeEventListener("DOMContentLoaded",K),a.removeEventListener("load",K)):(d.detachEvent("onreadystatechange",K),a.detachEvent("onload",K))}function K(){(d.addEventListener||"load"===a.event.type||"complete"===d.readyState)&&(J(),n.ready())}n.ready.promise=function(b){if(!I)if(I=n.Deferred(),"complete"===d.readyState||"loading"!==d.readyState&&!d.documentElement.doScroll)a.setTimeout(n.ready);else if(d.addEventListener)d.addEventListener("DOMContentLoaded",K),a.addEventListener("load",K);else{d.attachEvent("onreadystatechange",K),a.attachEvent("onload",K);var c=!1;try{c=null==a.frameElement&&d.documentElement}catch(e){}c&&c.doScroll&&!function f(){if(!n.isReady){try{c.doScroll("left")}catch(b){return a.setTimeout(f,50)}J(),n.ready()}}()}return I.promise(b)},n.ready.promise();var L;for(L in n(l))break;l.ownFirst="0"===L,l.inlineBlockNeedsLayout=!1,n(function(){var a,b,c,e;c=d.getElementsByTagName("body")[0],c&&c.style&&(b=d.createElement("div"),e=d.createElement("div"),e.style.cssText="position:absolute;border:0;width:0;height:0;top:0;left:-9999px",c.appendChild(e).appendChild(b),"undefined"!=typeof b.style.zoom&&(b.style.cssText="display:inline;margin:0;border:0;padding:1px;width:1px;zoom:1",l.inlineBlockNeedsLayout=a=3===b.offsetWidth,a&&(c.style.zoom=1)),c.removeChild(e))}),function(){var a=d.createElement("div");l.deleteExpando=!0;try{delete a.test}catch(b){l.deleteExpando=!1}a=null}();var M=function(a){var b=n.noData[(a.nodeName+" ").toLowerCase()],c=+a.nodeType||1;return 1!==c&&9!==c?!1:!b||b!==!0&&a.getAttribute("classid")===b},N=/^(?:\{[\w\W]*\}|\[[\w\W]*\])$/,O=/([A-Z])/g;function P(a,b,c){if(void 0===c&&1===a.nodeType){var d="data-"+b.replace(O,"-$1").toLowerCase();if(c=a.getAttribute(d),"string"==typeof c){try{c="true"===c?!0:"false"===c?!1:"null"===c?null:+c+""===c?+c:N.test(c)?n.parseJSON(c):c}catch(e){}n.data(a,b,c)}else c=void 0; +}return c}function Q(a){var b;for(b in a)if(("data"!==b||!n.isEmptyObject(a[b]))&&"toJSON"!==b)return!1;return!0}function R(a,b,d,e){if(M(a)){var f,g,h=n.expando,i=a.nodeType,j=i?n.cache:a,k=i?a[h]:a[h]&&h;if(k&&j[k]&&(e||j[k].data)||void 0!==d||"string"!=typeof b)return k||(k=i?a[h]=c.pop()||n.guid++:h),j[k]||(j[k]=i?{}:{toJSON:n.noop}),"object"!=typeof b&&"function"!=typeof b||(e?j[k]=n.extend(j[k],b):j[k].data=n.extend(j[k].data,b)),g=j[k],e||(g.data||(g.data={}),g=g.data),void 0!==d&&(g[n.camelCase(b)]=d),"string"==typeof b?(f=g[b],null==f&&(f=g[n.camelCase(b)])):f=g,f}}function S(a,b,c){if(M(a)){var d,e,f=a.nodeType,g=f?n.cache:a,h=f?a[n.expando]:n.expando;if(g[h]){if(b&&(d=c?g[h]:g[h].data)){n.isArray(b)?b=b.concat(n.map(b,n.camelCase)):b in d?b=[b]:(b=n.camelCase(b),b=b in d?[b]:b.split(" ")),e=b.length;while(e--)delete d[b[e]];if(c?!Q(d):!n.isEmptyObject(d))return}(c||(delete g[h].data,Q(g[h])))&&(f?n.cleanData([a],!0):l.deleteExpando||g!=g.window?delete g[h]:g[h]=void 0)}}}n.extend({cache:{},noData:{"applet ":!0,"embed ":!0,"object ":"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"},hasData:function(a){return a=a.nodeType?n.cache[a[n.expando]]:a[n.expando],!!a&&!Q(a)},data:function(a,b,c){return R(a,b,c)},removeData:function(a,b){return S(a,b)},_data:function(a,b,c){return R(a,b,c,!0)},_removeData:function(a,b){return S(a,b,!0)}}),n.fn.extend({data:function(a,b){var c,d,e,f=this[0],g=f&&f.attributes;if(void 0===a){if(this.length&&(e=n.data(f),1===f.nodeType&&!n._data(f,"parsedAttrs"))){c=g.length;while(c--)g[c]&&(d=g[c].name,0===d.indexOf("data-")&&(d=n.camelCase(d.slice(5)),P(f,d,e[d])));n._data(f,"parsedAttrs",!0)}return e}return"object"==typeof a?this.each(function(){n.data(this,a)}):arguments.length>1?this.each(function(){n.data(this,a,b)}):f?P(f,a,n.data(f,a)):void 0},removeData:function(a){return this.each(function(){n.removeData(this,a)})}}),n.extend({queue:function(a,b,c){var d;return a?(b=(b||"fx")+"queue",d=n._data(a,b),c&&(!d||n.isArray(c)?d=n._data(a,b,n.makeArray(c)):d.push(c)),d||[]):void 0},dequeue:function(a,b){b=b||"fx";var c=n.queue(a,b),d=c.length,e=c.shift(),f=n._queueHooks(a,b),g=function(){n.dequeue(a,b)};"inprogress"===e&&(e=c.shift(),d--),e&&("fx"===b&&c.unshift("inprogress"),delete f.stop,e.call(a,g,f)),!d&&f&&f.empty.fire()},_queueHooks:function(a,b){var c=b+"queueHooks";return n._data(a,c)||n._data(a,c,{empty:n.Callbacks("once memory").add(function(){n._removeData(a,b+"queue"),n._removeData(a,c)})})}}),n.fn.extend({queue:function(a,b){var c=2;return"string"!=typeof a&&(b=a,a="fx",c--),arguments.lengthh;h++)b(a[h],c,g?d:d.call(a[h],h,b(a[h],c)));return e?a:j?b.call(a):i?b(a[0],c):f},Z=/^(?:checkbox|radio)$/i,$=/<([\w:-]+)/,_=/^$|\/(?:java|ecma)script/i,aa=/^\s+/,ba="abbr|article|aside|audio|bdi|canvas|data|datalist|details|dialog|figcaption|figure|footer|header|hgroup|main|mark|meter|nav|output|picture|progress|section|summary|template|time|video";function ca(a){var b=ba.split("|"),c=a.createDocumentFragment();if(c.createElement)while(b.length)c.createElement(b.pop());return c}!function(){var a=d.createElement("div"),b=d.createDocumentFragment(),c=d.createElement("input");a.innerHTML="
    a",l.leadingWhitespace=3===a.firstChild.nodeType,l.tbody=!a.getElementsByTagName("tbody").length,l.htmlSerialize=!!a.getElementsByTagName("link").length,l.html5Clone="<:nav>"!==d.createElement("nav").cloneNode(!0).outerHTML,c.type="checkbox",c.checked=!0,b.appendChild(c),l.appendChecked=c.checked,a.innerHTML="",l.noCloneChecked=!!a.cloneNode(!0).lastChild.defaultValue,b.appendChild(a),c=d.createElement("input"),c.setAttribute("type","radio"),c.setAttribute("checked","checked"),c.setAttribute("name","t"),a.appendChild(c),l.checkClone=a.cloneNode(!0).cloneNode(!0).lastChild.checked,l.noCloneEvent=!!a.addEventListener,a[n.expando]=1,l.attributes=!a.getAttribute(n.expando)}();var da={option:[1,""],legend:[1,"
    ","
    "],area:[1,"",""],param:[1,"",""],thead:[1,"","
    "],tr:[2,"","
    "],col:[2,"","
    "],td:[3,"","
    "],_default:l.htmlSerialize?[0,"",""]:[1,"X
    ","
    "]};da.optgroup=da.option,da.tbody=da.tfoot=da.colgroup=da.caption=da.thead,da.th=da.td;function ea(a,b){var c,d,e=0,f="undefined"!=typeof a.getElementsByTagName?a.getElementsByTagName(b||"*"):"undefined"!=typeof a.querySelectorAll?a.querySelectorAll(b||"*"):void 0;if(!f)for(f=[],c=a.childNodes||a;null!=(d=c[e]);e++)!b||n.nodeName(d,b)?f.push(d):n.merge(f,ea(d,b));return void 0===b||b&&n.nodeName(a,b)?n.merge([a],f):f}function fa(a,b){for(var c,d=0;null!=(c=a[d]);d++)n._data(c,"globalEval",!b||n._data(b[d],"globalEval"))}var ga=/<|&#?\w+;/,ha=/r;r++)if(g=a[r],g||0===g)if("object"===n.type(g))n.merge(q,g.nodeType?[g]:g);else if(ga.test(g)){i=i||p.appendChild(b.createElement("div")),j=($.exec(g)||["",""])[1].toLowerCase(),m=da[j]||da._default,i.innerHTML=m[1]+n.htmlPrefilter(g)+m[2],f=m[0];while(f--)i=i.lastChild;if(!l.leadingWhitespace&&aa.test(g)&&q.push(b.createTextNode(aa.exec(g)[0])),!l.tbody){g="table"!==j||ha.test(g)?""!==m[1]||ha.test(g)?0:i:i.firstChild,f=g&&g.childNodes.length;while(f--)n.nodeName(k=g.childNodes[f],"tbody")&&!k.childNodes.length&&g.removeChild(k)}n.merge(q,i.childNodes),i.textContent="";while(i.firstChild)i.removeChild(i.firstChild);i=p.lastChild}else q.push(b.createTextNode(g));i&&p.removeChild(i),l.appendChecked||n.grep(ea(q,"input"),ia),r=0;while(g=q[r++])if(d&&n.inArray(g,d)>-1)e&&e.push(g);else if(h=n.contains(g.ownerDocument,g),i=ea(p.appendChild(g),"script"),h&&fa(i),c){f=0;while(g=i[f++])_.test(g.type||"")&&c.push(g)}return i=null,p}!function(){var b,c,e=d.createElement("div");for(b in{submit:!0,change:!0,focusin:!0})c="on"+b,(l[b]=c in a)||(e.setAttribute(c,"t"),l[b]=e.attributes[c].expando===!1);e=null}();var ka=/^(?:input|select|textarea)$/i,la=/^key/,ma=/^(?:mouse|pointer|contextmenu|drag|drop)|click/,na=/^(?:focusinfocus|focusoutblur)$/,oa=/^([^.]*)(?:\.(.+)|)/;function pa(){return!0}function qa(){return!1}function ra(){try{return d.activeElement}catch(a){}}function sa(a,b,c,d,e,f){var g,h;if("object"==typeof b){"string"!=typeof c&&(d=d||c,c=void 0);for(h in b)sa(a,h,c,d,b[h],f);return a}if(null==d&&null==e?(e=c,d=c=void 0):null==e&&("string"==typeof c?(e=d,d=void 0):(e=d,d=c,c=void 0)),e===!1)e=qa;else if(!e)return a;return 1===f&&(g=e,e=function(a){return n().off(a),g.apply(this,arguments)},e.guid=g.guid||(g.guid=n.guid++)),a.each(function(){n.event.add(this,b,e,d,c)})}n.event={global:{},add:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,o,p,q,r=n._data(a);if(r){c.handler&&(i=c,c=i.handler,e=i.selector),c.guid||(c.guid=n.guid++),(g=r.events)||(g=r.events={}),(k=r.handle)||(k=r.handle=function(a){return"undefined"==typeof n||a&&n.event.triggered===a.type?void 0:n.event.dispatch.apply(k.elem,arguments)},k.elem=a),b=(b||"").match(G)||[""],h=b.length;while(h--)f=oa.exec(b[h])||[],o=q=f[1],p=(f[2]||"").split(".").sort(),o&&(j=n.event.special[o]||{},o=(e?j.delegateType:j.bindType)||o,j=n.event.special[o]||{},l=n.extend({type:o,origType:q,data:d,handler:c,guid:c.guid,selector:e,needsContext:e&&n.expr.match.needsContext.test(e),namespace:p.join(".")},i),(m=g[o])||(m=g[o]=[],m.delegateCount=0,j.setup&&j.setup.call(a,d,p,k)!==!1||(a.addEventListener?a.addEventListener(o,k,!1):a.attachEvent&&a.attachEvent("on"+o,k))),j.add&&(j.add.call(a,l),l.handler.guid||(l.handler.guid=c.guid)),e?m.splice(m.delegateCount++,0,l):m.push(l),n.event.global[o]=!0);a=null}},remove:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,o,p,q,r=n.hasData(a)&&n._data(a);if(r&&(k=r.events)){b=(b||"").match(G)||[""],j=b.length;while(j--)if(h=oa.exec(b[j])||[],o=q=h[1],p=(h[2]||"").split(".").sort(),o){l=n.event.special[o]||{},o=(d?l.delegateType:l.bindType)||o,m=k[o]||[],h=h[2]&&new RegExp("(^|\\.)"+p.join("\\.(?:.*\\.|)")+"(\\.|$)"),i=f=m.length;while(f--)g=m[f],!e&&q!==g.origType||c&&c.guid!==g.guid||h&&!h.test(g.namespace)||d&&d!==g.selector&&("**"!==d||!g.selector)||(m.splice(f,1),g.selector&&m.delegateCount--,l.remove&&l.remove.call(a,g));i&&!m.length&&(l.teardown&&l.teardown.call(a,p,r.handle)!==!1||n.removeEvent(a,o,r.handle),delete k[o])}else for(o in k)n.event.remove(a,o+b[j],c,d,!0);n.isEmptyObject(k)&&(delete r.handle,n._removeData(a,"events"))}},trigger:function(b,c,e,f){var g,h,i,j,l,m,o,p=[e||d],q=k.call(b,"type")?b.type:b,r=k.call(b,"namespace")?b.namespace.split("."):[];if(i=m=e=e||d,3!==e.nodeType&&8!==e.nodeType&&!na.test(q+n.event.triggered)&&(q.indexOf(".")>-1&&(r=q.split("."),q=r.shift(),r.sort()),h=q.indexOf(":")<0&&"on"+q,b=b[n.expando]?b:new n.Event(q,"object"==typeof b&&b),b.isTrigger=f?2:3,b.namespace=r.join("."),b.rnamespace=b.namespace?new RegExp("(^|\\.)"+r.join("\\.(?:.*\\.|)")+"(\\.|$)"):null,b.result=void 0,b.target||(b.target=e),c=null==c?[b]:n.makeArray(c,[b]),l=n.event.special[q]||{},f||!l.trigger||l.trigger.apply(e,c)!==!1)){if(!f&&!l.noBubble&&!n.isWindow(e)){for(j=l.delegateType||q,na.test(j+q)||(i=i.parentNode);i;i=i.parentNode)p.push(i),m=i;m===(e.ownerDocument||d)&&p.push(m.defaultView||m.parentWindow||a)}o=0;while((i=p[o++])&&!b.isPropagationStopped())b.type=o>1?j:l.bindType||q,g=(n._data(i,"events")||{})[b.type]&&n._data(i,"handle"),g&&g.apply(i,c),g=h&&i[h],g&&g.apply&&M(i)&&(b.result=g.apply(i,c),b.result===!1&&b.preventDefault());if(b.type=q,!f&&!b.isDefaultPrevented()&&(!l._default||l._default.apply(p.pop(),c)===!1)&&M(e)&&h&&e[q]&&!n.isWindow(e)){m=e[h],m&&(e[h]=null),n.event.triggered=q;try{e[q]()}catch(s){}n.event.triggered=void 0,m&&(e[h]=m)}return b.result}},dispatch:function(a){a=n.event.fix(a);var b,c,d,f,g,h=[],i=e.call(arguments),j=(n._data(this,"events")||{})[a.type]||[],k=n.event.special[a.type]||{};if(i[0]=a,a.delegateTarget=this,!k.preDispatch||k.preDispatch.call(this,a)!==!1){h=n.event.handlers.call(this,a,j),b=0;while((f=h[b++])&&!a.isPropagationStopped()){a.currentTarget=f.elem,c=0;while((g=f.handlers[c++])&&!a.isImmediatePropagationStopped())a.rnamespace&&!a.rnamespace.test(g.namespace)||(a.handleObj=g,a.data=g.data,d=((n.event.special[g.origType]||{}).handle||g.handler).apply(f.elem,i),void 0!==d&&(a.result=d)===!1&&(a.preventDefault(),a.stopPropagation()))}return k.postDispatch&&k.postDispatch.call(this,a),a.result}},handlers:function(a,b){var c,d,e,f,g=[],h=b.delegateCount,i=a.target;if(h&&i.nodeType&&("click"!==a.type||isNaN(a.button)||a.button<1))for(;i!=this;i=i.parentNode||this)if(1===i.nodeType&&(i.disabled!==!0||"click"!==a.type)){for(d=[],c=0;h>c;c++)f=b[c],e=f.selector+" ",void 0===d[e]&&(d[e]=f.needsContext?n(e,this).index(i)>-1:n.find(e,this,null,[i]).length),d[e]&&d.push(f);d.length&&g.push({elem:i,handlers:d})}return h]","i"),va=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:-]+)[^>]*)\/>/gi,wa=/\s*$/g,Aa=ca(d),Ba=Aa.appendChild(d.createElement("div"));function Ca(a,b){return n.nodeName(a,"table")&&n.nodeName(11!==b.nodeType?b:b.firstChild,"tr")?a.getElementsByTagName("tbody")[0]||a.appendChild(a.ownerDocument.createElement("tbody")):a}function Da(a){return a.type=(null!==n.find.attr(a,"type"))+"/"+a.type,a}function Ea(a){var b=ya.exec(a.type);return b?a.type=b[1]:a.removeAttribute("type"),a}function Fa(a,b){if(1===b.nodeType&&n.hasData(a)){var c,d,e,f=n._data(a),g=n._data(b,f),h=f.events;if(h){delete g.handle,g.events={};for(c in h)for(d=0,e=h[c].length;e>d;d++)n.event.add(b,c,h[c][d])}g.data&&(g.data=n.extend({},g.data))}}function Ga(a,b){var c,d,e;if(1===b.nodeType){if(c=b.nodeName.toLowerCase(),!l.noCloneEvent&&b[n.expando]){e=n._data(b);for(d in e.events)n.removeEvent(b,d,e.handle);b.removeAttribute(n.expando)}"script"===c&&b.text!==a.text?(Da(b).text=a.text,Ea(b)):"object"===c?(b.parentNode&&(b.outerHTML=a.outerHTML),l.html5Clone&&a.innerHTML&&!n.trim(b.innerHTML)&&(b.innerHTML=a.innerHTML)):"input"===c&&Z.test(a.type)?(b.defaultChecked=b.checked=a.checked,b.value!==a.value&&(b.value=a.value)):"option"===c?b.defaultSelected=b.selected=a.defaultSelected:"input"!==c&&"textarea"!==c||(b.defaultValue=a.defaultValue)}}function Ha(a,b,c,d){b=f.apply([],b);var e,g,h,i,j,k,m=0,o=a.length,p=o-1,q=b[0],r=n.isFunction(q);if(r||o>1&&"string"==typeof q&&!l.checkClone&&xa.test(q))return a.each(function(e){var f=a.eq(e);r&&(b[0]=q.call(this,e,f.html())),Ha(f,b,c,d)});if(o&&(k=ja(b,a[0].ownerDocument,!1,a,d),e=k.firstChild,1===k.childNodes.length&&(k=e),e||d)){for(i=n.map(ea(k,"script"),Da),h=i.length;o>m;m++)g=k,m!==p&&(g=n.clone(g,!0,!0),h&&n.merge(i,ea(g,"script"))),c.call(a[m],g,m);if(h)for(j=i[i.length-1].ownerDocument,n.map(i,Ea),m=0;h>m;m++)g=i[m],_.test(g.type||"")&&!n._data(g,"globalEval")&&n.contains(j,g)&&(g.src?n._evalUrl&&n._evalUrl(g.src):n.globalEval((g.text||g.textContent||g.innerHTML||"").replace(za,"")));k=e=null}return a}function Ia(a,b,c){for(var d,e=b?n.filter(b,a):a,f=0;null!=(d=e[f]);f++)c||1!==d.nodeType||n.cleanData(ea(d)),d.parentNode&&(c&&n.contains(d.ownerDocument,d)&&fa(ea(d,"script")),d.parentNode.removeChild(d));return a}n.extend({htmlPrefilter:function(a){return a.replace(va,"<$1>")},clone:function(a,b,c){var d,e,f,g,h,i=n.contains(a.ownerDocument,a);if(l.html5Clone||n.isXMLDoc(a)||!ua.test("<"+a.nodeName+">")?f=a.cloneNode(!0):(Ba.innerHTML=a.outerHTML,Ba.removeChild(f=Ba.firstChild)),!(l.noCloneEvent&&l.noCloneChecked||1!==a.nodeType&&11!==a.nodeType||n.isXMLDoc(a)))for(d=ea(f),h=ea(a),g=0;null!=(e=h[g]);++g)d[g]&&Ga(e,d[g]);if(b)if(c)for(h=h||ea(a),d=d||ea(f),g=0;null!=(e=h[g]);g++)Fa(e,d[g]);else Fa(a,f);return d=ea(f,"script"),d.length>0&&fa(d,!i&&ea(a,"script")),d=h=e=null,f},cleanData:function(a,b){for(var d,e,f,g,h=0,i=n.expando,j=n.cache,k=l.attributes,m=n.event.special;null!=(d=a[h]);h++)if((b||M(d))&&(f=d[i],g=f&&j[f])){if(g.events)for(e in g.events)m[e]?n.event.remove(d,e):n.removeEvent(d,e,g.handle);j[f]&&(delete j[f],k||"undefined"==typeof d.removeAttribute?d[i]=void 0:d.removeAttribute(i),c.push(f))}}}),n.fn.extend({domManip:Ha,detach:function(a){return Ia(this,a,!0)},remove:function(a){return Ia(this,a)},text:function(a){return Y(this,function(a){return void 0===a?n.text(this):this.empty().append((this[0]&&this[0].ownerDocument||d).createTextNode(a))},null,a,arguments.length)},append:function(){return Ha(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ca(this,a);b.appendChild(a)}})},prepend:function(){return Ha(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ca(this,a);b.insertBefore(a,b.firstChild)}})},before:function(){return Ha(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this)})},after:function(){return Ha(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this.nextSibling)})},empty:function(){for(var a,b=0;null!=(a=this[b]);b++){1===a.nodeType&&n.cleanData(ea(a,!1));while(a.firstChild)a.removeChild(a.firstChild);a.options&&n.nodeName(a,"select")&&(a.options.length=0)}return this},clone:function(a,b){return a=null==a?!1:a,b=null==b?a:b,this.map(function(){return n.clone(this,a,b)})},html:function(a){return Y(this,function(a){var b=this[0]||{},c=0,d=this.length;if(void 0===a)return 1===b.nodeType?b.innerHTML.replace(ta,""):void 0;if("string"==typeof a&&!wa.test(a)&&(l.htmlSerialize||!ua.test(a))&&(l.leadingWhitespace||!aa.test(a))&&!da[($.exec(a)||["",""])[1].toLowerCase()]){a=n.htmlPrefilter(a);try{for(;d>c;c++)b=this[c]||{},1===b.nodeType&&(n.cleanData(ea(b,!1)),b.innerHTML=a);b=0}catch(e){}}b&&this.empty().append(a)},null,a,arguments.length)},replaceWith:function(){var a=[];return Ha(this,arguments,function(b){var c=this.parentNode;n.inArray(this,a)<0&&(n.cleanData(ea(this)),c&&c.replaceChild(b,this))},a)}}),n.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){n.fn[a]=function(a){for(var c,d=0,e=[],f=n(a),h=f.length-1;h>=d;d++)c=d===h?this:this.clone(!0),n(f[d])[b](c),g.apply(e,c.get());return this.pushStack(e)}});var Ja,Ka={HTML:"block",BODY:"block"};function La(a,b){var c=n(b.createElement(a)).appendTo(b.body),d=n.css(c[0],"display");return c.detach(),d}function Ma(a){var b=d,c=Ka[a];return c||(c=La(a,b),"none"!==c&&c||(Ja=(Ja||n("